JuicyPixels 3.1.2 → 3.1.3

raw patch · 48 files changed

+9730/−8642 lines, 48 filesdep +containers

Dependencies added: containers

Files

• Codec/Picture.hs +0/−226
• Codec/Picture/BitWriter.hs +0/−265
• Codec/Picture/Bitmap.hs +0/−350
• Codec/Picture/ConvGraph.hs +0/−9
• Codec/Picture/Gif.hs +0/−380
• Codec/Picture/Gif/LZW.hs +0/−189
• Codec/Picture/HDR.hs +0/−462
• Codec/Picture/InternalHelper.hs +0/−33
• Codec/Picture/Jpg.hs +0/−720
• Codec/Picture/Jpg/Common.hs +0/−232
• Codec/Picture/Jpg/DefaultTable.hs +0/−294
• Codec/Picture/Jpg/FastDct.hs +0/−203
• Codec/Picture/Jpg/FastIdct.hs +0/−228
• Codec/Picture/Jpg/Progressive.hs +0/−309
• Codec/Picture/Jpg/Types.hs +0/−546
• Codec/Picture/Png.hs +0/−500
• Codec/Picture/Png/Export.hs +0/−163
• Codec/Picture/Png/Type.hs +0/−329
• Codec/Picture/Saving.hs +0/−165
• Codec/Picture/Tiff.hs +0/−1285
• Codec/Picture/Types.hs +0/−1727
• Codec/Picture/VectorByteConversion.hs +0/−20
• JuicyPixels.cabal +11/−7
• changelog +6/−0
• src/Codec/Picture.hs +304/−0
• src/Codec/Picture/BitWriter.hs +299/−0
• src/Codec/Picture/Bitmap.hs +350/−0
• src/Codec/Picture/ColorQuant.hs +380/−0
• src/Codec/Picture/ConvGraph.hs +9/−0
• src/Codec/Picture/Gif.hs +685/−0
• src/Codec/Picture/Gif/LZW.hs +189/−0
• src/Codec/Picture/Gif/LZWEncoding.hs +93/−0
• src/Codec/Picture/HDR.hs +462/−0
• src/Codec/Picture/InternalHelper.hs +33/−0
• src/Codec/Picture/Jpg.hs +721/−0
• src/Codec/Picture/Jpg/Common.hs +232/−0
• src/Codec/Picture/Jpg/DefaultTable.hs +294/−0
• src/Codec/Picture/Jpg/FastDct.hs +203/−0
• src/Codec/Picture/Jpg/FastIdct.hs +228/−0
• src/Codec/Picture/Jpg/Progressive.hs +321/−0
• src/Codec/Picture/Jpg/Types.hs +546/−0
• src/Codec/Picture/Png.hs +501/−0
• src/Codec/Picture/Png/Export.hs +192/−0
• src/Codec/Picture/Png/Type.hs +329/−0
• src/Codec/Picture/Saving.hs +187/−0
• src/Codec/Picture/Tiff.hs +1285/−0
• src/Codec/Picture/Types.hs +1837/−0
• src/Codec/Picture/VectorByteConversion.hs +33/−0

@@ -1,226 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE CPP #-}
--- | Main module for image import/export into various image formats.
---
--- To use the library without thinking about it, look after 'decodeImage' and
--- 'readImage'.
---
--- Generally, the read* functions read the images from a file and try to decode
--- it, and the decode* functions try to decode a bytestring.
---
--- For an easy image writing use the 'saveBmpImage', 'saveJpgImage' & 'savePngImage'
--- functions
-module Codec.Picture ( 
-                     -- * Generic functions
-                       readImage
-                     , decodeImage
-                     , pixelMap
-                     , generateImage
-                     , generateFoldImage
-                     , withImage
-
-                     -- * Generic image writing
-                     , saveBmpImage
-                     , saveJpgImage
-                     , savePngImage
-                     , saveTiffImage
-                     , saveRadianceImage
-
-                     -- * Specific image format functions
-                     -- ** Bitmap handling 
-                     , BmpEncodable
-                     , writeBitmap
-                     , encodeBitmap
-                     , readBitmap
-                     , decodeBitmap
-                     , encodeDynamicBitmap 
-                     , writeDynamicBitmap 
-
-                     -- ** Gif handling
-                     , readGif
-                     , readGifImages
-                     , decodeGif
-                     , decodeGifImages
-
-                     -- ** Jpeg handling
-                     , readJpeg
-                     , decodeJpeg 
-                     , encodeJpeg
-                     , encodeJpegAtQuality
-
-                     -- ** Png handling
-                     , PngSavable( .. )
-                     , readPng
-                     , decodePng
-                     , writePng
-                     , encodeDynamicPng
-                     , writeDynamicPng
-
-                     -- ** Tiff handling
-                     , readTiff
-                     , TiffSaveable
-                     , decodeTiff
-                     , encodeTiff
-                     , writeTiff
-
-                     -- ** HDR (Radiance/RGBE) handling
-                     , readHDR
-                     , decodeHDR
-                     , encodeHDR
-                     , writeHDR
-
-                     -- * Image types and pixel types
-                     -- ** Image
-                     , Image( .. )
-                     , DynamicImage( .. )
-                     -- ** Pixels
-                     , Pixel( .. )
-                     -- $graph
-                     , Pixel8
-                     , Pixel16
-                     , PixelF
-
-                     , PixelYA8( .. )
-                     , PixelYA16( .. )
-                     , PixelRGB8( .. )
-                     , PixelRGB16( .. )
-                     , PixelRGBF( .. )
-                     , PixelRGBA8( .. )
-                     , PixelRGBA16( .. )
-                     , PixelYCbCr8( .. )
-                     , PixelCMYK8( .. )
-                     , PixelCMYK16( .. )
-                     ) where
-
-import Control.Applicative( (<$>) )
-import Control.DeepSeq( NFData, deepseq )
-import qualified Control.Exception as Exc ( catch, IOException )
-import Codec.Picture.Bitmap( BmpEncodable, decodeBitmap
-                           , writeBitmap, encodeBitmap
-                           , encodeDynamicBitmap, writeDynamicBitmap )
-import Codec.Picture.Jpg( decodeJpeg, encodeJpeg, encodeJpegAtQuality )
-import Codec.Picture.Png( PngSavable( .. ), decodePng, writePng
-                        , encodeDynamicPng , writeDynamicPng )
-import Codec.Picture.Gif( decodeGif, decodeGifImages )
-import Codec.Picture.HDR( decodeHDR
-                        , encodeHDR
-                        , writeHDR
-                        )
-import Codec.Picture.Tiff( decodeTiff
-                         , TiffSaveable
-                         , encodeTiff
-                         , writeTiff )
-import Codec.Picture.Saving
-import Codec.Picture.Types
--- import System.IO ( withFile, IOMode(ReadMode) )
-#ifdef WITH_MMAP_BYTESTRING
-import System.IO.MMap ( mmapFileByteString )
-#endif
-
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Lazy as L
-
-#include "ConvGraph.hs"
-
--- | Return the first Right thing, accumulating error
-eitherLoad :: c -> [(String, c -> Either String b)] -> Either String b
-eitherLoad v = inner ""
-    where inner errAcc [] = Left $ "Cannot load file\n" ++ errAcc
-          inner errAcc ((hdr, f) : rest) = case f v of
-                Left  err  -> inner (errAcc ++ hdr ++ " " ++ err ++ "\n") rest
-                Right rez  -> Right rez
-
-withImageDecoder :: (NFData a)
-                 => (B.ByteString -> Either String a) -> FilePath
-                 -> IO (Either String a)
-withImageDecoder decoder path = Exc.catch doit
-                    (\e -> return . Left $ show (e :: Exc.IOException))
-    where doit = force . decoder <$> get
-#ifdef WITH_MMAP_BYTESTRING
-          get = mmapFileByteString path Nothing
-#else
-          get = B.readFile path
-#endif
-          -- force appeared in deepseq 1.3, Haskell Platform
-          -- provide 1.1
-          force x = x `deepseq` x
-
--- | Load an image file without even thinking about it, it does everything
--- as 'decodeImage'
-readImage :: FilePath -> IO (Either String DynamicImage)
-readImage = withImageDecoder decodeImage
-
--- | If you want to decode an image in a bytestring without even thinking
--- in term of format or whatever, this is the function to use. It will try
--- to decode in each known format and if one decoding succeed will return
--- the decoded image in it's own colorspace
-decodeImage :: B.ByteString -> Either String DynamicImage
-decodeImage str = eitherLoad str [("Jpeg", decodeJpeg)
-                                 ,("PNG", decodePng)
-                                 ,("Bitmap", decodeBitmap)
-                                 ,("GIF", decodeGif)
-                                 ,("HDR", decodeHDR)
-                                 ,("Tiff", decodeTiff)
-                                 ]
-    
--- | Helper function trying to load a png file from a file on disk.
-readPng :: FilePath -> IO (Either String DynamicImage)
-readPng = withImageDecoder decodePng 
-
--- | Helper function trying to load a gif file from a file on disk.
-readGif :: FilePath -> IO (Either String DynamicImage)
-readGif = withImageDecoder decodeGif
-
--- | Helper function trying to load tiff file from a file on disk.
-readTiff :: FilePath -> IO (Either String DynamicImage)
-readTiff = withImageDecoder decodeTiff
-
--- | Helper function trying to load all the images of an animated
--- gif file.
-readGifImages :: FilePath -> IO (Either String [Image PixelRGB8])
-readGifImages = withImageDecoder decodeGifImages
-
--- | Try to load a jpeg file and decompress. The colorspace is still
--- YCbCr if you want to perform computation on the luma part. You can
--- convert it to RGB using 'colorSpaceConversion'
-readJpeg :: FilePath -> IO (Either String DynamicImage)
-readJpeg = withImageDecoder decodeJpeg
-
--- | Try to load a .bmp file. The colorspace would be RGB or RGBA
-readBitmap :: FilePath -> IO (Either String DynamicImage)
-readBitmap = withImageDecoder decodeBitmap
-
--- | Try to load a .pic file. The colorspace can only be
--- RGB with floating point precision.
-readHDR :: FilePath -> IO (Either String DynamicImage)
-readHDR = withImageDecoder decodeHDR
-
--- | Save an image to a '.jpg' file, will do everything it can to save an image.
-saveJpgImage :: Int -> FilePath -> DynamicImage -> IO ()
-saveJpgImage quality path img = L.writeFile path $ imageToJpg quality img
-
--- | Save an image to a '.tiff' file, will do everything it can to save an image.
-saveTiffImage :: FilePath -> DynamicImage -> IO ()
-saveTiffImage path img = L.writeFile path $ imageToTiff img
-
--- | Save an image to a '.hdr' file, will do everything it can to save an image.
-saveRadianceImage :: FilePath -> DynamicImage -> IO ()
-saveRadianceImage path = L.writeFile path . imageToRadiance
-
--- | Save an image to a '.png' file, will do everything it can to save an image.
--- For example, a simple transcoder to png
---
--- > transcodeToPng :: FilePath -> FilePath -> IO ()
--- > transcodeToPng pathIn pathOut = do
--- >    eitherImg <- readImage pathIn
--- >    case eitherImg of
--- >        Left _ -> return ()
--- >        Right img -> savePngImage pathOut img
---
-savePngImage :: String -> DynamicImage -> IO ()
-savePngImage path img = L.writeFile path $ imageToPng img
-
--- | Save an image to a '.bmp' file, will do everything it can to save an image.
-saveBmpImage :: String -> DynamicImage -> IO ()
-saveBmpImage path img = L.writeFile path $ imageToBitmap img
-

@@ -1,265 +0,0 @@-{-# LANGUAGE Rank2Types #-}
--- | This module implement helper functions to read & write data
--- at bits level.
-module Codec.Picture.BitWriter( BoolReader
-                              , emptyBoolState
-                              , BoolState
-                              , byteAlignJpg
-                              , getNextBitsLSBFirst
-                              , getNextBitsMSBFirst 
-                              , getNextBitJpg
-                              , setDecodedString
-                              , setDecodedStringJpg
-                              , runBoolReader
-
-                              , BoolWriteStateRef 
-                              , newWriteStateRef
-                              , finalizeBoolWriter
-                              , writeBits'
-
-                              , initBoolState 
-                              , initBoolStateJpg
-                              , execBoolReader
-                              , runBoolReaderWith
-                              ) where
-
-import Data.STRef
-import Control.Applicative( (<$>), (<*>) )
-import Control.Monad( when )
-import Control.Monad.ST( ST )
-import qualified Control.Monad.Trans.State.Strict as S
-import Data.Word( Word8, Word32 )
-import Data.Bits( Bits, (.&.), (.|.), unsafeShiftR, unsafeShiftL )
-
-import Codec.Picture.VectorByteConversion( blitVector )
-import qualified Data.Vector.Storable.Mutable as M
-import qualified Data.Vector.Storable as VS
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Lazy as L
-
---------------------------------------------------
-----            Reader
---------------------------------------------------
--- | Current bit index, current value, string
-data BoolState = BoolState {-# UNPACK #-} !Int
-                           {-# UNPACK #-} !Word8
-                           !B.ByteString
-
-emptyBoolState :: BoolState
-emptyBoolState = BoolState (-1) 0 B.empty
-
--- | Type used to read bits
-type BoolReader s a = S.StateT BoolState (ST s) a
-
-runBoolReader :: BoolReader s a -> ST s a
-runBoolReader action = S.evalStateT action $ BoolState 0 0 B.empty
-
-runBoolReaderWith :: BoolState -> BoolReader s a -> ST s (a, BoolState)
-runBoolReaderWith st action = S.runStateT action st
-
-execBoolReader :: BoolState -> BoolReader s a -> ST s BoolState
-execBoolReader st reader = S.execStateT reader st
-
-initBoolState :: B.ByteString -> BoolState
-initBoolState str = case B.uncons str of
-     Nothing -> BoolState 0 0 B.empty
-     Just (v, rest) -> BoolState 0 v rest
-
-initBoolStateJpg :: B.ByteString -> BoolState
-initBoolStateJpg str = 
-   case B.uncons str of
-     Nothing -> BoolState 0 0 B.empty
-     Just (0xFF, rest) -> case B.uncons rest of
-            Nothing                  -> BoolState maxBound 0 B.empty
-            Just (0x00, afterMarker) -> BoolState 7 0xFF afterMarker
-            Just (_   , afterMarker) -> initBoolStateJpg afterMarker
-     Just (v, rest) -> BoolState 7 v rest
-
--- | Bitify a list of things to decode.
-setDecodedString :: B.ByteString -> BoolReader s ()
-setDecodedString str = case B.uncons str of
-     Nothing        -> S.put $ BoolState      0 0 B.empty
-     Just (v, rest) -> S.put $ BoolState      0 v    rest
-
--- | Drop all bit until the bit of indice 0, usefull to parse restart
--- marker, as they are byte aligned, but Huffman might not.
-byteAlignJpg :: BoolReader s ()
-byteAlignJpg = do
-  BoolState idx _ chain <- S.get
-  when (idx /= 7) (setDecodedStringJpg chain)
-
-{-# INLINE getNextBitJpg #-}
-getNextBitJpg :: BoolReader s Bool
-getNextBitJpg = do
-    BoolState idx v chain <- S.get
-    let val = (v .&. (1 `unsafeShiftL` idx)) /= 0
-    if idx == 0
-      then setDecodedStringJpg chain
-      else S.put $ BoolState (idx - 1) v chain
-    return val
-
-{-# INLINE getNextBitMSB #-}
-getNextBitMSB :: BoolReader s Bool
-getNextBitMSB = do
-    BoolState idx v chain <- S.get
-    let val = (v .&. (1 `unsafeShiftL` (7 - idx))) /= 0
-    if idx == 7
-      then setDecodedString chain
-      else S.put $ BoolState (idx + 1) v chain
-    return val
-
-{-# INLINE getNextBitsMSBFirst #-}
-getNextBitsMSBFirst :: Int -> BoolReader s Word32
-getNextBitsMSBFirst count = aux 0 count
-  where aux acc 0 = return acc
-        aux acc n = do
-            bit <- getNextBitMSB
-            let nextVal | bit = (acc `unsafeShiftL` 1) .|. 1
-                        | otherwise = acc `unsafeShiftL` 1
-            aux nextVal (n - 1)
-
-{-# INLINE getNextBitsLSBFirst #-}
-getNextBitsLSBFirst :: Int -> BoolReader s Word32
-getNextBitsLSBFirst count = aux 0 count
-  where aux acc 0 = return acc
-        aux acc n = do
-            bit <- getNextBit
-            let nextVal | bit = acc .|. (1 `unsafeShiftL` (count - n))
-                        | otherwise = acc
-            aux nextVal (n - 1)
-
-{-# INLINE getNextBit #-}
-getNextBit :: BoolReader s Bool
-getNextBit = do
-    BoolState idx v chain <- S.get
-    let val = (v .&. (1 `unsafeShiftL` idx)) /= 0
-    if idx == 7
-      then setDecodedString chain
-      else S.put $ BoolState (idx + 1) v chain
-    return val
-
--- | Bitify a list of things to decode. Handle Jpeg escape
--- code (0xFF 0x00), thus should be only used in JPEG decoding.
-setDecodedStringJpg :: B.ByteString -> BoolReader s ()
-setDecodedStringJpg str = case B.uncons str of
-     Nothing        -> S.put $ BoolState maxBound 0 B.empty
-     Just (0xFF, rest) -> case B.uncons rest of
-            Nothing                  -> S.put $ BoolState maxBound 0 B.empty
-            Just (0x00, afterMarker) -> -- trace "00" $ 
-                S.put $ BoolState 7 0xFF afterMarker
-            Just (_   , afterMarker) -> setDecodedStringJpg afterMarker
-     Just (v, rest) ->
-        S.put $ BoolState 7 v rest
-
---------------------------------------------------
-----            Writer
---------------------------------------------------
-defaultBufferSize :: Int
-defaultBufferSize = 256 * 1024
-
-data BoolWriteStateRef s = BoolWriteStateRef
-        { bwsCurrBuffer   :: STRef s (M.MVector s Word8)
-        , bwsBufferList   :: STRef s [B.ByteString]
-        , bwsWrittenWords :: STRef s Int
-        , bwsBitAcc       :: STRef s Word8
-        , bwsBitReaded    :: STRef s Int
-        }
-
-newWriteStateRef :: ST s (BoolWriteStateRef s)
-newWriteStateRef = do
-    origMv <- M.new defaultBufferSize
-    BoolWriteStateRef <$> newSTRef origMv
-                      <*> newSTRef []
-                      <*> newSTRef 0
-                      <*> newSTRef 0
-                      <*> newSTRef 0
-
-finalizeBoolWriter :: BoolWriteStateRef s -> ST s L.ByteString
-finalizeBoolWriter st = do
-    forceBufferFlushing' st
-    L.fromChunks <$> readSTRef (bwsBufferList st)
-
-forceBufferFlushing' :: BoolWriteStateRef s -> ST s ()
-forceBufferFlushing' (BoolWriteStateRef { bwsCurrBuffer = vecRef
-                                        , bwsWrittenWords = countRef
-                                        , bwsBufferList = lstRef
-                                        }) = do
-    vec <- readSTRef vecRef
-    count <- readSTRef countRef
-    lst <- readSTRef lstRef
-
-    nmv <- M.new defaultBufferSize
-    str <- byteStringFromVector vec count
-
-    writeSTRef vecRef nmv
-    writeSTRef lstRef $ lst ++ [str]
-    writeSTRef countRef 0
-
-flushCurrentBuffer' :: BoolWriteStateRef s -> ST s ()
-flushCurrentBuffer' st = do
-    count <- readSTRef $ bwsWrittenWords st
-    when (count >= defaultBufferSize)
-         (forceBufferFlushing' st)
-
-byteStringFromVector :: M.MVector s Word8 -> Int -> ST s B.ByteString
-byteStringFromVector vec size = do
-    frozen <- VS.unsafeFreeze vec
-    return $ blitVector frozen 0 size
-
-setBitCount' :: BoolWriteStateRef s -> Word8 -> Int -> ST s ()
-{-# INLINE setBitCount' #-}
-setBitCount' st acc count = do
-    writeSTRef (bwsBitAcc st) acc
-    writeSTRef (bwsBitReaded st) count
-
-resetBitCount' :: BoolWriteStateRef s -> ST s ()
-{-# INLINE resetBitCount' #-}
-resetBitCount' st = setBitCount' st 0 0
-
-pushByte' :: BoolWriteStateRef s -> Word8 -> ST s ()
-{-# INLINE pushByte' #-}
-pushByte' st v = do
-    flushCurrentBuffer' st
-    idx <- readSTRef (bwsWrittenWords st)
-    vec <- readSTRef (bwsCurrBuffer st)
-    M.write vec idx v
-    writeSTRef (bwsWrittenWords st) $ idx + 1
-
--- | Append some data bits to a Put monad.
-writeBits' :: BoolWriteStateRef s
-           -> Word32     -- ^ The real data to be stored. Actual data should be in the LSB
-           -> Int        -- ^ Number of bit to write from 1 to 32
-           -> ST s ()
-{-# INLINE writeBits' #-}
-writeBits' st d c = do
-    currWord <- readSTRef $ bwsBitAcc st
-    currCount <- readSTRef $  bwsBitReaded st
-    serialize d c currWord currCount
-  where dumpByte 0xFF = pushByte' st 0xFF >> pushByte' st 0x00
-        dumpByte    i = pushByte' st i
-
-        serialize bitData bitCount currentWord count
-            | bitCount + count == 8 = do
-                     resetBitCount' st
-                     dumpByte (fromIntegral $ (currentWord `unsafeShiftL` bitCount) .|.
-                                                fromIntegral cleanData)
-
-            | bitCount + count < 8 =
-                let newVal = currentWord `unsafeShiftL` bitCount
-                in setBitCount' st (newVal .|. fromIntegral cleanData) $ count + bitCount
-
-            | otherwise =
-                let leftBitCount = 8 - count :: Int
-                    highPart = cleanData `unsafeShiftR` (bitCount - leftBitCount) :: Word32
-                    prevPart = fromIntegral currentWord `unsafeShiftL` leftBitCount :: Word32
-
-                    nextMask = (1 `unsafeShiftL` (bitCount - leftBitCount)) - 1 :: Word32
-                    newData = cleanData .&. nextMask :: Word32
-                    newCount = bitCount - leftBitCount :: Int
-
-                    toWrite = fromIntegral $ prevPart .|. highPart :: Word8
-                in dumpByte toWrite >> serialize newData newCount 0 0
-
-              where cleanMask = (1 `unsafeShiftL` bitCount) - 1 :: Word32
-                    cleanData = bitData .&. cleanMask     :: Word32
-

@@ -1,350 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeSynonymInstances #-}
--- | Modules used for Bitmap file (.bmp) file loading and writing
-module Codec.Picture.Bitmap( -- * Functions
-                             writeBitmap
-                           , encodeBitmap
-                           , decodeBitmap
-                           , encodeDynamicBitmap 
-                           , writeDynamicBitmap 
-                             -- * Accepted formt in output
-                           , BmpEncodable( )
-                           ) where
-import Control.Monad( when, forM_ )
-import Control.Monad.ST ( ST, runST )
-import qualified Data.Vector.Storable as V
-import qualified Data.Vector.Storable.Mutable as M
-import Data.Binary( Binary( .. ) )
-import Data.Binary.Put( Put
-                      , runPut
-                      , putWord16le
-                      , putWord32le
-                      , putByteString 
-                      )
-
-import Data.Binary.Get( Get
-                      , getWord16le 
-                      , getWord32le
-                      , bytesRead
-                      , skip
-                      )
-
-import Data.Word( Word32, Word16, Word8 )
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Lazy as L
-
-import Codec.Picture.InternalHelper
-import Codec.Picture.Types
-import Codec.Picture.VectorByteConversion
-
-data BmpHeader = BmpHeader
-    { magicIdentifier :: !Word16
-    , fileSize        :: !Word32 -- ^ in bytes
-    , reserved1       :: !Word16
-    , reserved2       :: !Word16
-    , dataOffset      :: !Word32
-    }
-
-bitmapMagicIdentifier :: Word16
-bitmapMagicIdentifier = 0x4D42
-
-instance Binary BmpHeader where
-    put hdr = do
-        putWord16le $ magicIdentifier hdr
-        putWord32le $ fileSize hdr
-        putWord16le $ reserved1 hdr
-        putWord16le $ reserved2 hdr
-        putWord32le $ dataOffset hdr
-
-    get = do
-        ident <- getWord16le
-        when (ident /= bitmapMagicIdentifier)
-             (fail "Invalid Bitmap magic identifier")
-        fsize <- getWord32le
-        r1 <- getWord16le
-        r2 <- getWord16le
-        offset <- getWord32le
-        return BmpHeader
-            { magicIdentifier = ident
-            , fileSize = fsize
-            , reserved1 = r1
-            , reserved2 = r2
-            , dataOffset = offset
-            }
-
-
-data BmpInfoHeader = BmpInfoHeader
-    { size              :: !Word32 -- Header size in bytes
-    , width             :: !Word32
-    , height            :: !Word32
-    , planes            :: !Word16 -- Number of colour planes
-    , bitPerPixel       :: !Word16
-    , bitmapCompression :: !Word32
-    , byteImageSize     :: !Word32
-    , xResolution       :: !Word32 -- ^ Pixels per meter
-    , yResolution       :: !Word32 -- ^ Pixels per meter
-    , colorCount        :: !Word32
-    , importantColours  :: !Word32
-    }
-
-sizeofBmpHeader, sizeofBmpInfo  :: Word32
-sizeofBmpHeader = 2 + 4 + 2 + 2 + 4
-sizeofBmpInfo = 3 * 4 + 2 * 2 + 6 * 4
-
-instance Binary BmpInfoHeader where
-    put hdr = do
-        putWord32le $ size hdr
-        putWord32le $ width hdr
-        putWord32le $ height hdr
-        putWord16le $ planes hdr
-        putWord16le $ bitPerPixel hdr
-        putWord32le $ bitmapCompression hdr
-        putWord32le $ byteImageSize hdr
-        putWord32le $ xResolution hdr
-        putWord32le $ yResolution hdr
-        putWord32le $ colorCount hdr
-        putWord32le $ importantColours hdr
-
-    get = do
-        readSize <- getWord32le
-        readWidth <- getWord32le
-        readHeight <- getWord32le
-        readPlanes <- getWord16le
-        readBitPerPixel <- getWord16le
-        readBitmapCompression <- getWord32le
-        readByteImageSize <- getWord32le
-        readXResolution <- getWord32le
-        readYResolution <- getWord32le
-        readColorCount <- getWord32le
-        readImportantColours <- getWord32le
-        return BmpInfoHeader {
-            size = readSize,
-            width = readWidth,
-            height = readHeight,
-            planes = readPlanes,
-            bitPerPixel = readBitPerPixel,
-            bitmapCompression = readBitmapCompression,
-            byteImageSize = readByteImageSize,
-            xResolution = readXResolution,
-            yResolution = readYResolution,
-            colorCount = readColorCount,
-            importantColours = readImportantColours
-        }
-
-newtype BmpPalette = BmpPalette [(Word8, Word8, Word8, Word8)]
-
-putPalette :: BmpPalette -> Put
-putPalette (BmpPalette p) = mapM_ (\(r, g, b, a) -> put r >> put g >> put b >> put a) p
-
--- | All the instance of this class can be written as a bitmap file
--- using this library.
-class BmpEncodable pixel where
-    bitsPerPixel   :: pixel -> Int
-    bmpEncode      :: Image pixel -> Put
-    defaultPalette :: pixel -> BmpPalette
-    defaultPalette _ = BmpPalette []
-
-stridePut :: M.STVector s Word8 -> Int -> Int -> ST s ()
-{-# INLINE stridePut #-}
-stridePut vec = inner
- where inner  _ 0 = return ()
-       inner ix n = do
-           (vec `M.unsafeWrite` ix) 0
-           inner (ix + 1) (n - 1)
-
-instance BmpEncodable Pixel8 where
-    defaultPalette _ = BmpPalette [(x,x,x, 255) | x <- [0 .. 255]]
-    bitsPerPixel _ = 8
-    bmpEncode (Image {imageWidth = w, imageHeight = h, imageData = arr}) =
-      forM_ [h - 1, h - 2 .. 0] $ \l -> putVector $ runST $ encodeLine l
-        where stride = fromIntegral $ linePadding 8 w
-              putVector vec = putByteString $ blitVector vec 0 lineWidth
-              lineWidth = w + stride
-
-              encodeLine line = do
-                  buff <- M.new lineWidth
-
-                  let lineIdx = line * w
-                      inner col | col >= w = return ()
-                      inner col = do
-                          let v = (arr `V.unsafeIndex` (lineIdx + col))
-                          (buff `M.unsafeWrite` col) v
-                          inner (col + 1)
-
-                  inner 0
-
-                  stridePut buff w stride
-                  V.unsafeFreeze buff
-
-instance BmpEncodable PixelRGBA8 where
-    bitsPerPixel _ = 32
-    bmpEncode (Image {imageWidth = w, imageHeight = h, imageData = arr}) = 
-      forM_ [h - 1, h - 2 .. 0] $ \l -> putVector $ runST $ putLine l
-      where putVector vec = putByteString . blitVector vec 0 $ w * 4
-            putLine line = do
-                buff <- M.new $ 4 * w
-                let initialIndex = line * w * 4
-                    inner col _ _ | col >= w = return ()
-                    inner col writeIdx readIdx = do
-                        let r = arr `V.unsafeIndex` readIdx
-                            g = arr `V.unsafeIndex` (readIdx + 1)
-                            b = arr `V.unsafeIndex` (readIdx + 2)
-                            a = arr `V.unsafeIndex` (readIdx + 3)
-
-                        (buff `M.unsafeWrite` writeIdx) b
-                        (buff `M.unsafeWrite` (writeIdx + 1)) g
-                        (buff `M.unsafeWrite` (writeIdx + 2)) r
-                        (buff `M.unsafeWrite` (writeIdx + 3)) a
-
-                        inner (col + 1) (writeIdx + 4) (readIdx + 4)
-
-                inner 0 0 initialIndex
-                V.unsafeFreeze buff
-
-instance BmpEncodable PixelRGB8 where
-    bitsPerPixel _ = 24
-    bmpEncode (Image {imageWidth = w, imageHeight = h, imageData = arr}) =
-       forM_ [h - 1, h - 2 .. 0] $ \l -> putVector $ runST $ putLine l
-        where stride = fromIntegral . linePadding 24 $ w
-              putVector vec = putByteString $ blitVector vec 0 (w * 3 + stride)
-              putLine line = do
-                  buff <- M.new $ w * 3 + stride
-                  let initialIndex = line * w * 3
-                      inner col _ _ | col >= w = return ()
-                      inner col writeIdx readIdx = do
-                          let r = (arr `V.unsafeIndex` readIdx)
-                              g = (arr `V.unsafeIndex` (readIdx + 1))
-                              b = (arr `V.unsafeIndex` (readIdx + 2))
-                          
-                          (buff `M.unsafeWrite` writeIdx) b
-                          (buff `M.unsafeWrite` (writeIdx + 1)) g
-                          (buff `M.unsafeWrite` (writeIdx + 2)) r
-
-                          inner (col + 1) (writeIdx + 3) (readIdx + 3)
-
-                  inner 0 0 initialIndex
-                  V.unsafeFreeze buff
-
-decodeImageRGB8 :: BmpInfoHeader -> B.ByteString -> Image PixelRGB8
-decodeImageRGB8 (BmpInfoHeader { width = w, height = h }) str = Image wi hi stArray
-  where wi = fromIntegral w
-        hi = fromIntegral h
-        stArray = runST $ do
-            arr <- M.new (fromIntegral $ w * h * 3)
-            forM_ [hi - 1, hi - 2 .. 0] (readLine arr)
-            V.unsafeFreeze arr
-
-        stride = linePadding 24 wi
-        readLine arr line =
-            let readIndex = (wi * 3 + stride) * line
-                lastIndex = wi * (hi - 1 - line + 1) * 3
-                writeIndex = wi * (hi - 1 - line) * 3
-
-                inner _ writeIdx | writeIdx >= lastIndex = return ()
-                inner readIdx writeIdx = do
-                    (arr `M.unsafeWrite`  writeIdx     ) (str `B.index` (readIdx + 2))
-                    (arr `M.unsafeWrite` (writeIdx + 1)) (str `B.index` (readIdx + 1))
-                    (arr `M.unsafeWrite` (writeIdx + 2)) (str `B.index`  readIdx)
-                    inner (readIdx + 3) (writeIdx + 3)
-
-            in inner readIndex writeIndex
-
-
--- | Try to decode a bitmap image.
--- Right now this function can output the following pixel types :
---
---    * PixelRGB8
---
-decodeBitmap :: B.ByteString -> Either String DynamicImage
-decodeBitmap str = flip runGetStrict str $ do
-  hdr      <- get :: Get BmpHeader
-  bmpHeader <- get :: Get BmpInfoHeader
-  case (bitPerPixel bmpHeader, planes  bmpHeader,
-              bitmapCompression bmpHeader) of
-    -- (32, 1, 0) -> {- ImageRGBA8 <$>-} fail "Meuh"
-    (24, 1, 0) -> do
-        readed <- bytesRead
-
-        when (readed > fromIntegral (dataOffset hdr))
-             (fail "Invalid bmp image, data in header")
-
-        skip . fromIntegral $ dataOffset hdr - fromIntegral readed
-        rest <- getRemainingBytes
-        return . ImageRGB8 $ decodeImageRGB8 bmpHeader rest
-    a          -> fail $ "Can't handle BMP file " ++ show a
-
-
--- | Write an image in a file use the bitmap format.
-writeBitmap :: (BmpEncodable pixel)
-            => FilePath -> Image pixel -> IO ()
-writeBitmap filename img = L.writeFile filename $ encodeBitmap img
-
-linePadding :: Int -> Int -> Int
-linePadding bpp imgWidth = (4 - (bytesPerLine `mod` 4)) `mod` 4
-    where bytesPerLine = imgWidth * (fromIntegral bpp `div` 8)
-
--- | Encode an image into a bytestring in .bmp format ready to be written
--- on disk.
-encodeBitmap :: forall pixel. (BmpEncodable pixel) => Image pixel -> L.ByteString
-encodeBitmap = encodeBitmapWithPalette (defaultPalette (undefined :: pixel))
-
-
--- | Write a dynamic image in a .bmp image file if possible.
--- The same restriction as encodeDynamicBitmap apply.
-writeDynamicBitmap :: FilePath -> DynamicImage -> IO (Either String Bool)
-writeDynamicBitmap path img = case encodeDynamicBitmap img of
-        Left err -> return $ Left err
-        Right b  -> L.writeFile path b >> return (Right True)
-
--- | Encode a dynamic image in bmp if possible, supported pixel type are :
---
---   - RGB8
---
---   - RGBA8
---
---   - Y8
---
-encodeDynamicBitmap :: DynamicImage -> Either String L.ByteString
-encodeDynamicBitmap (ImageRGB8 img) = Right $ encodeBitmap img
-encodeDynamicBitmap (ImageRGBA8 img) = Right $ encodeBitmap img
-encodeDynamicBitmap (ImageY8 img) = Right $ encodeBitmap img
-encodeDynamicBitmap _ = Left "Unsupported image format for bitmap export"
-
-
--- | Convert an image to a bytestring ready to be serialized.
-encodeBitmapWithPalette :: forall pixel. (BmpEncodable pixel)
-                        => BmpPalette -> Image pixel -> L.ByteString
-encodeBitmapWithPalette pal@(BmpPalette palette) img =
-  runPut $ put hdr >> put info >> putPalette pal >> bmpEncode img
-    where imgWidth = fromIntegral $ imageWidth img
-          imgHeight = fromIntegral $ imageHeight img
-
-          paletteSize = fromIntegral $ length palette
-          bpp = bitsPerPixel (undefined :: pixel)
-          padding = linePadding bpp (imgWidth + 1)
-          imagePixelSize = fromIntegral $ (imgWidth + padding) * imgHeight * 4
-          hdr = BmpHeader {
-              magicIdentifier = bitmapMagicIdentifier,
-              fileSize = sizeofBmpHeader + sizeofBmpInfo + 4 * paletteSize + imagePixelSize,
-              reserved1 = 0,
-              reserved2 = 0,
-              dataOffset = sizeofBmpHeader + sizeofBmpInfo + 4 * paletteSize
-          }
-
-          info = BmpInfoHeader {
-              size = sizeofBmpInfo,
-              width = fromIntegral imgWidth,
-              height = fromIntegral imgHeight,
-              planes = 1,
-              bitPerPixel = fromIntegral bpp,
-              bitmapCompression = 0, -- no compression
-              byteImageSize = imagePixelSize,
-              xResolution = 0,
-              yResolution = 0,
-              colorCount = 0,
-              importantColours = paletteSize
-          }
-
-

@@ -1,9 +0,0 @@--- $graph
---
--- The following graph describe the differents way to convert between pixel types,
---
--- * Nodes describe pixel type
---
--- * Arrows describe functions
---
--- <<data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAABAwAAALbCAAAAABbY00HAACj/UlEQVR42u1ddVxUTRc+dwtYukERRVExMFHsbuzu7lbs7n7t+LA7sDuwOzCxGwtFBRRp2Pn+oHaX3eXG3Lu7MM/3e/3Y3TtnZs6cee7EmTOACAgICBBCQFRAQEBAyICAgICQAQEBASGDXIqEsGfBF4KCAgMPBgVdDn4ZnkxUQkDIIFch8emRFaPbVnS3AHVYeVTtPGHtybcpREkEhAxyOKJOz+5QUgqUa6X2Y5ZsPnL16btfEREIJUdE/Hj3+NLBjQtHtCznAGBWvvuiq7FEXYQMiApyJsK29i4hEhVtMy3wWbzOB//d3zG+aQGQlh92IIqojZABQc5C8oXxZSmrRtNP0+/dYYfGVzcVV551T0HUR8iAIIdAcW2wI1V24pUkxiljTg71BI+Jj4kOCRkQ5AB8m5kPyi3+xDr9symFofjKP0SRhAwIjBs3O0qdJ73iKOTuIAvLQS+IMgkZEBgvbtWHSjviMQj6s7KoqMsrolBCBgTGiRd+UO0CLmEpe70kvcKIUgkZEBgfYqfKyp7FKTBlewGbtcQdiZABgbHhXmHL5UmYZf4bJ6n8nqiWkAGBUWGVSZMvPIh9UsbuBFEuIQMC40FyN/FsfnyF4vpTc4h+CRkQGAsS2lif5034Jsl4omFCBgTGgZSWdsE8ij8km0h0TMiAwCgw3YZf/+GT4n1EyYQMCIwAp8Unec7hPzlxRyRkQGD4iC84jfc82jYgeiZkQGDwWFoogfc8vlmcJoomZEBg4Iix25G1SQEAsjYtpP0C6Q8pP5v+dPonVUwsSzRNyIDAwHFA/k9zk4KmrzO7vfJ/aX+ofKWKZ/BM5fMPonhCBgSGho5tkFYyyOjfGQMFyMIK9MgAec3I+DPlxgQoQRRPyIDA0FBkji4ySO3ioPRRhQxojwxQl5ap///vUC9bkIEXUTwhAwJDg3wr0rVmoE4GyssJAErfqHyZFWN9EEJf/tdISkkBAJoQxRMyIDAwJMAR7U2q1MEhc2SgtKKgNE1Q4wR1zCn0YGZpSixO5Q6qM9E8IQMCQ4PDOp1kAEpzAtUVAnUyQKpsoYqI0iqXr0iaXgp+843ESSRkQGBIKDuJHhmAKhmo7yakk4O2kUHjIgDSDDKQWab+v3WewuVrN+3Q33/6ooDdR88Hv/wcSVqEkAGBnuDvq4sMtO4mqPsZZI4UNK4ZJNpuUgS1lUrSycD/x7v7V08Hblg+d/zAbq3rVSxRwDb9N+v8pao37TJk0sKAfWduvfgWQ5qIkAGBMLhNhQqQy1npL4TQj0UeqcMDk7kanon79e7RjXOB6xdPGdqtec0yHrap5CB1KFS+Xpveo2Ys23LocsjXONJkhAwI8KF2lcm7H6QFQVaUmyRAjq06peV2qYNUQoHJUlqpokKfXDu+c8288f07NKxULI85AACY5ytdp+3ASUu2HL32/HsiaUxCBgRcUAJMRCDK13T81rt/0Xn5Z94zvGL6IePvX/8VAljHSkzi9+fXjm5ZMmlg2zql86VSg1WB8g06DZm6fPuJW69+kpYlZEDAEJNlqRt8JiIAl5oORZ/wnF+U51hVbuh6EIPUuK8hlw9tXDi2T6saJfOYAABIXEvV7zJy3ubjt0PJldCEDAjoYC+lstFnNoTf7BRNvPlfBvz36eH5Xcun9G1euaA5AIB5wcrN+05ZsftiyHcSrp2QAYE2hCjt+EPzNxclS3nlggHWb4StX8zH28c3zxvZpZ63qwQARM4l63QePnvD0VufE0jjEzIgSO8nt/83oIpFmiMgiCifGwihjaJ5/OWY3F1+SY8VDn92ee/KqQNaVi1iCQDg5N2ox6SVB66/J7sShAxyMcLPLexUTAyWVQav90zlArHr7tQA6TvEg+N5yjXSz+qqgSggLvTm4VVTezYp5UwBgG3xut0mrDxy9yuZRRAyyEVIebVvkl9egLx+k/e/VSCEuooBQGo2J2OZ7bBVBX7cDe55uN8zPIUkfrlzdN30fk3LOgOAxK1K2xFLdl97H08shZBBTkbSk81DqliAuFinhefCM75dJAMp1fOb0nOvy9htxH+NSsJMk0a/DFo/8e+v7V4yom0VNwkAOJdrPnzxvptfFcRuCBnksPHAs+3Dq8rBrPLg9ffUdtpOA9QPURtDj5JUC8FcgoEmVPWl+29+STYGbX27e2TlhM5V84kBZAVrdp+y/vQz4gpNyMD4oXi9a3QNSzCpMGjjY023qX7x1BCg9EEFSd+PGAvxsBnlDCCjAMTOFTqMXn7wjlEEO0sKvbZz/iC/klYAYF+2tf+qE8+I0wIhA+PEu8CxdaxBWrZfQLB2Z12N9y2nbC0oG/gBFxW0oXxOoZHpHg0imQxgsFEpMirk+NrxHSo4AoBz5U4TNwS9Ic7PhAyMBr9PTG5gBxLvXmvusNs5S1yfX9z8HPcpc+Le6lD6iAKhTDYAAPholFr99+TYipEtSlsBiN1r9pq7734ksTRCBoaM5Ef/61EEqCLdVtzgNNNNPlibKjLnLbdBwVhXSduLaR8y2UDaw7hV/Ct4/6LBDQtJABwqdZ256xY5CkHIwCAHBHUtwbLe5BO/cYh7NiovVFzK0mlQ8WBGUSg6XensUwYbUK9yhLYT355ZPdKvqAmAjU/HKVtu/CIGSMjAoAYEPQIe4Vuyjx1o39sRPIeeiGKYMGxvTxfwGPtA9dtRqWwgyfcsJ2k+5eP5/41p6S0HcKjaZ9GRV2Q9gZCBHhGJd0CQgSclbPailOB5NSSi4r03Pabnzv/v7spOBUHeeKmGK1bT2KCouHdozmuF0KA1Q+vnp0BatMW4Tdd/ETIgEBoRR0eVE2MeEKSN81eYVkvrs39Oz2hkDZJi7WbsvPZJWz4Jby9umdCsoAhcWi24qmXZchQFIG2SstPDzD+H9paYB3tndipnAWBfpd/yoG+EDAiEwa9DI8qIRKWHH+JjBeuHn2Smcr9PeXlgZrviJgCS/L6NuwybvmBdQEBg4J6AgNULpgzu2NAnDwVgXq7bguMfdEkdRQHcQShhhaPN6qQc3DSfzq8ZVtcFwLb6gFUXfhAyIOATPw4M86bEZUce+c2P/DMuBW5oGi58u7VvsX+ZvNVLFLS3tQUQ29o6FSxVq3WfccsP36fDSaOhFEIIoegJsuI5/kLmX1fWDa7tCGBfa/DaS78IGRDgx/d9g0tQYh//Y5F85ZA4nuqk4zKDBt3Zix59Ie2PN62g0cvc0FzhF1YPrGEP4NJo/O7nyYQMCHAh8sAgL5D4jj3J58UjoZXkW3T97rAMSzaXysqm5BoH37CgZT3KycDUp9+qq38IGRBwRNK1qZXF4koTT//lN5/D9iWf6/r9I1zDVKHlloXO5qYWTHy0w7+uI4BHqxmH3hMyIGCJN2taWIHHgAMRfGeUMIrqo9t38aAoGldmX9pCx1y35P7l1Pz2XmKwqTf+wAdCBgQM+2fQKE+wbrFGiAiC730sdmbzyBxPjPmd8LDZmhvbNOb2ur5lJODQaMqRL4QMCGhONje0tgDviVeE2Ynbb1Mm21W9Xo1w5hg7UtQ0t+7Hx91a1aOEGFybzTj5nZABgW48nlGekjdd90moOe0oGJD9McfqmE8gX/O03ZGL2zj62tIuRSnI127ZrXhCBgQakXJjbCFwH3JSuPC9X6pb7KLxWF7cAdVjhola5nL/3T8XF7VyAZMq/ofCCBkQqL2jgwbmgaIT7woZhe+SS1E68c5iqKPYs77s7naZNHro7mHlJVCw68rgJEIGBGljgisD7aH83OeCZqpYKGlLawP8FTzAn3tkG/H0ZNLyCP27NKeZI5jXmnzyLyEDggdj8kH5JUKf6/vTUvIfvWHIbeDlgtZ1ZtVDSeOn8e3W/iVF4gpjT/whZJCL8WFmMSgyXXg33ceFXelecXIa/vFShJASDheJAWQg4tiosmJxhTHH/xAyyI2ID6wnyjNaH3eN7JLXoL1wtUPGUyFiOkmWESNQmTwdG1VeLPbxPx5JyCB34dkoB2mLE/qYOCePhdH0l6xWOvNWkCXiruTqwyyE4F9eLC4/9kICIYNcgsTdlcFzgX6cbyIamjLZ55/vxV9RguzLfSLGkAVRx/3LUhZNVr0mZJAL2H9BPkmHy3q6zCvEMx+jmcn8QjwW5p13nsfEHjQhbFsXRygw8HAUIYOcjLfDLGzG6O2FeMiiOrNQPPPd+SzOnzpW54lJaEZK8LwaEkmNOXdTCBnkTLzqJCq4XG97yopp1ECG8Xz5JQOU0EW2g1iFVkQfGVgIHLsG/iVkkOMQ2ldSbJ/+vG3+NDNZzzTNan7JACnGUYuIYejCm1UNZaZNAr4RMshJ+D7cxGObHh3v3pVwvcE40VoXvou1ippJbCMbFt/XyVpUecELQgY5ZQq4zjrPWn1uGF1zKM/iLH2ghHf62kBNI+aR7Xzq3GA3KDr+ZgohA+PHs6qS8XoNAbjDpBUbX8KbwH80jk2iKcRAaMyo7k0uCc79g5IJGRg3r0+TVXikV0OaCBNZvVQ+wU3+S7dZPInYCC28XVKVchlxm5CBETehj/lyvfJ5bFvZFnYpkySBApRvCzWfWAlNfJhXCgpOeUbIwDix26qsfq8i/lre4SrbtPmWClHC+aKjxE5oI2SSB5ReGErIwOgQ04capt8IVw/dvN6yTly/ryBlHCS/TUyFwbTvxjBnqtran4QMjIvFi9kf0W8Jjlk04BByfUI57U0OAIDJEJKbO75hZHepWUPuNcrkMz2spe2CUggZGA3+Z6rvKB7rxAO4xNU6IIvV0eT4zCDGt8hfRmSgIffcZpRxO2tSheaHETIwCkS2FU3Rb4Q7xURqHicBv0RBqS9ilPo/lPZGTh0SpHbJjG9TBwrKT6T/rfEJFTMKc+6cZllqSZQTpQvJzDlNioZxQq7AC38HaZszKYQMDB4PC7rqOZxPQnfZNo4ifMandzek1AmVOrNy11T6F9T/zvKEmhkFidejDHEqWYFKIjUZat/lOsTvqU15zPlKyMCwsUNeO1y/JfhbzzKIq4zpRRFS677Kf6WZAgAovaUzf8n8XukJSLchVSuaIn+iOSs1MoC0MYIKIaVLz414PdZJ2vKMgpCBwSJxOOWv5yDYX0vn4e7q9BQeZU8Gau96jSMBlWmFJjJIrlHsHx0yUDJAFULKxUaZsK8uVSwglpCBYSKsmsVePRfhWf7iHzGIKTkiY5qANE4TkOrvoD7xz0IXql1YibwchiKV+YVWMoDM7p/bpwkZpN3X1GHyN0IGBogbeQo/1XMRrtjWwHKL80qb6IwFRKRxAREp/Q7qC4hq6TKf0GBE+0TXlZgmIwkoiVVdLMz1C4jKCJ/lIuv1kpCBoWGNrFmknotw0LQdnnijkRYrWTQ/sDKiFl7xxLLYI36zl6jtfUIGBrVc0Fc0U6HnMmwWj8C14TQ6TywvZKDhka/Wk4llcUHKgXLQ6CohA4NBVH2LY/ouw1JqBjZZPyyEC0a0XvqIGBA3nK0J9W8RMjAMvC/h9lDfZZhKrcAobZrVF6EKrqhVSUFMiCMuVoWmwYQMDAB3nMt81nMRFEPF23DKi/NsJVjZQyS7iA1xxpkKVJs3hAz0jf1mzaL1XISkrqaYz0ZdoP4nWOkHuccQK+KOY8VlQ38SMtArFlJD9R2WKq655QXcMmfIrgtV/HCbWcSMcLwSAlxtFscSMtDf+HyYeJW+y/C3lv0d/BVr6fhcqAosMf9CLAkHoiebFzpByEBPSO4pO6TvMvzyycOHt1NMbSehbkJL8OxFTAkPvnSAFh8IGegDCW3lZ/Vdhp9lCr7nRXBMQ/sbAtVhl+QNMSZMOO9lNieBkIHgiGlsfU3fZQj3LszXVkZ8G5MAYSqRUqwrsSZsb6j55t7BhAwExp8aDvf1XYYfJYryd7BdMVs0ME6QauwVvyT2hA3vakkmxhMyEHiu/lzfZQgr5sXrsbVjViUfCjI08O5MDAoji6+zLH6PkIFwiKrg8V7fZfjmVYzneHgfa8nmC7Fzul/0nJgUznarJ12sIGQg1HpBdTe9h7H/UrTED97f2UtMfe7xXxVF8T7EprAqdLG0QRghA0GQ0MBZ7wvgnwt7CxFk7XlN0eBI3nNZL/tGrAor7nk6nydkIACSW9k90XcZQguVEcb7VLHNyTmA73huCa6TiVnhxd/OkqWEDHhHSldrvV8H9Nmj7C+h8oocKit+nOc8ZttEE8PCjKWSrnGEDHjGIPllfRchvEjZ3wJm96Y1VYtfF6QIDeGVCDjivL1PGCEDXrFMekrfRYjwLi5wUPZb1aABr5e1DylM4hpgx/uSBV8RMuARx8Vr9V2EP76ewodQOF8NGvFIB0/hHLEt/G+Nmo53CRnwhifWw/VdhJhabnrxcQiqCtVP8Pb+rtGKGBd+xLWyOE/IgK/JukdjfccvSGjsqC/v3at+VMltPJ2D2S35TMwLP5L7yy8RMuCnI1b2jtJ367axeay/3EO6S12m8BJ/IMFpOrEvHqDoL79KyIAP9HZ8q++27W6p333NL1NdJG0u8jBbmJAvhRgYHxbTG7fFEDJACKGdEn0fWlYMll/UtxYS91SD4mv+4hb7giwh8jSW7OH4hpABbry2nKfvIkyQnTQETTzqb2455BlmoZVIWAN+kFSnaBQhA8yz2nL19D2QXSvebyDKiFxWBCoHYLWx/8n/ECPjBVHedRIIGWDFCOcwPZfgqP59HJRmLEFdzMy6BOHbXIkwXfL0XlDQscDAoKCrwe+JfzI+fHAcS8gAJ46J9O15eFM+wcDeOAGVIc/4F5yHsSH7Fw5sUNQWVGGSt0KHCesv/Camxx2XJGcIGeDDN/uxei7BE+suhuey+2qqO6fpwouAfj6mIPGo03d2wKGrz95HRMQhFBER9u7eqR3LxrYpZwPg3nzaaTJM4IhpGIe1hAwauSfotwCf3eokGKJiUoK6mJm02M2iu375X0dXsKs/bvfzRO0P/Tq/pGtJsaTy+ItJpEuzR3KNpoQMcOGwWM/HlqO89e7vpL1sWxpJzdruZ3Sfz6v5FSnb1iue0BrsRB4bVY6y734olvRqtgi1OELIAJO55xmp3wIk1HEzaHfdX+vrii06HVENy3tDW/yi6I2VId/QIEbv+s+r60lshgaTbs0S/7n/I2SABQPy63fWquhi/cTQdfR9TQ2RdfeTSnOZ6nBU04PvB1uYdbnCYv3jx1JvKLebTBdYIanUBEIGOHCVOq3fAkyQXTAGPX1Z6ktZddyX5p2YKAIYkOWO5WddJB6rWc94bnaWFFyXQLo2C1w0+UzIgDvii3bRbwE2UTuNZm66oo7EpMn67wihiwAg8Xyo8vPPwRLvXZze7e8GmXoeIl2bBWoOJmTAHUusvus1/+uy+cakrl9bW8pFVRe/9ZcBgET6X+aEIGWFjesmzm6coZ2oWq9J32YxNPhCyICzcdvO0Wv+nx27GZvKYg51twOLVOchUZ30Le6PtWSTsay93ConX0vCpDFG1RGEDLhiZL4YvXassr5xRqi1pB3proRS29R1xMNWJR9gEp44ReIXRXo3Q2yzjSNkwA1vZFv1mb2ivdsXo9TbCkk6G4iogbEILRINw0hqt91KfCTdmxn+We0hZMANbcrp9bDibLPbxqm3+qLMcwaSwo+HS9ZhFf+1vAu5oZEh+tUnZMAJ16nz+sz+iPFsJKgiNpMJZCYAIMYdieFfEzcyNmCG86JfhAy4oHoTfeb+xHKckertBIDYIk9Rnzrt+o6curCLaAr26+BianiSCAiMEGe2l5ABB1yFW3rMPbyQX7KRKi4yXOkkwTOzTTxkEVWiG+ngjNCgLyEDDmhYV4+ZJ9YpliPWzJPKdOZFbohpIOngTLAoPyED9rgL+gxAOsLmTY7Q4ro8kfwIXuJOXJMZLRpABCED1mhRVY+ZH6RO5AglJrjzda1qXN61pIczwGe4TsiALR5TeoxG/N56XM7Q4mZHdQcDAADIaleQ9gukP6T8bPpnFSwuQDwRmcBqIyEDtuhYXo/v0/JVE3OGFv16aLQn0GRmkPG78n/pv2RJ8hbukx7OAD7jCBmwRKhkn/4yH2ofmjO0GGu2TxsZQHoXzxgoQBZW0EkGyGs26eEMUL8/IQOWmJhHf5E0DlAnc4gWn8NT7WSQygeg9FGFDLIbGaC2bUkPZ4DWnQgZsHylOejvtfMupywYIHQesvi9Ka0ZqJOB8nICgMo3GtYM0IhqpIczQA8/QgbssFWmtzgGCeWr5pjwXocgSZs9KfV6ANX3P81pwpTSpIczwKBqhAzYoWx3vWU9xOFTjlHjDfiqgwxAaU6g1PXpkkG/esqfUshNzoQMeMEt/Xki788xCwYIofdwlw4ZgCoZ0NtNQE17ZEys9o4pADGkvxMy4AMdffXWfazH5yA9KvKs0E4GWncT6PkZJNttQAh9PTKlnhVQMiCX/RAy4AW/ZFv0lHNyZd8cFA88JqRZA96EX6N2z23uBGBCAQBARdLdCRnwgZWW//SU82zzHHEk4eetXbN6VHMFyC/jy2PiuzsAZAZREZNTjIQMeEHZPnrK+K40wKgVl/zx/PrxbctaAUgLNxry39GQ2DoDecrqk2yQhYjKvLh5ELmAjZABD3gE1/Q0rPZqaqw6Cz27ckjjIjIAyzJtxv3v/Pv0WAzXpTxdi9a2Hkra7JZBByKg8tUZsPjoc3KWkZABToworKcjMEMdvxudsuJDAud0Lm8O4Fil+8ydt36o/97fi5dl/i3mrxBCievzpNPB9sML+9XKCyD2qD9k2anXiaT3EzLAgATHufrJ+Dx1xJj09PvGxrFNPcUgLuQ3ZsN1bSH2/hVpx0PEptvytPlUwlpnMQBAmkPDv4f75/aq6gQgLdx45Opz74nzASEDTjgk0s+tx9EenY1DQSnvT//Xv6YjgHnZTrMCH8frfvqJdT/sA60ntpnrhfErHcUAJiq//7m3Z1ZXXzsAs7Kd5hx4ToYJhAxYonlD/eQ7xOmnwevmx/mlfXzkAC61Bi4/+5FeJ78q7495u/SOS3Pl0UbsMjvNbga/b20a61dQBNJibSbvfhBLyICQAdPRr2y7XvK9TO03ZLXE3Ns0qp4TgFPdURtvM4ugddayAdZ4jvvNWqktE8Ys7q398dgHuye3KSYFUUG/sZtuRxEyIGRAGxtN/+oj23+FDPZE7q9zCzsVE4Hcp/fSoB+sRvXuRa9j64Tx4ymLoXcYJ0t8fmBOp7JmAHnrDVt3NYqQASEDGqjXRi/ZjnL4YYDKCD06rbk7QF6/KQdeM1uMu346MGDJDP/+7RpU9MorBuiKaarwuJTl6lleUGTWW1bLHe9OLOrtaw3g0WLagbcKQgaEDHThu1gvo/X74h0GpoivhyfVtwNRkfbzz4SzSF4JQCIzkUnT/AD85cVPYyhUeAlR4bsIoXsjnKnKq1lfEhR6Yk77ImKwqDLwfzejCRkQMtCCVZb6OP6WXL6uAb2mos7Pa5kXRMV7rLzK+uKivZnXLYLU4z162woahXAsV8JqBzsAKDz00C+UfKqLhbTZXg6rgjG31w+uZgUiz7azj34gZEDIICuqddFHritMXxlG9ZOCV3XzoiBfm4UXuS2dJDhk3rhY4RdCCF0qK2rJ5WT43yV5TPwjTwKAjKKKjzr+J3pnI7F1z/OcfAkU7w/NaFWIApuawzbciyNkQMhACZ+o43rI9bPlLAOo+98z0+pZgG3DKcfCMEibkj5DEDdNe32nHKkENXeyfJe/GGVn6f8VITQh1clIBqJy48++X+4Decc84lrWP9fXDPA1B0mpXmvvxBMyIGSQiiW2+nBub11M3yYYuntwaTEU6bHhOabpyvcxaUcKqYFKPgGX2plYD73J+F3+83+VodD81A3N5MrpLAMyMP2LXkz1AO8FGA5HprwKHFfHGqTl+294kEjIgJABqtxLD5me1etNbujDpq55QVrZ/xC+kxHBPUzsK0kAACg13+7wpaXBtf9pBuODt8tqii26Xskgqa92mSeXtyGEkOL6IDtRzS1YVgIVr3aNqmEBppWG7XhHyCB3k8FX0THhM030aqe/Cu/s7QHyBvOvYvTPS9xbBUqtjz0NACLxNg29e3FVkaza1KDIbCUlP9/UzQ2c+h5Xmc2fSycDaZOMFYoj7Uwsel7BNKpJfrptqK8MHJvPu/SPkEGuJYPVFnpYRFoi18+dKT8DB3uBSc0Z17DOjMLn5BW3voQQSskHErOzWrI+ONybAtdWM/fdU9ofVFqyTHx7bt0AXznYNFsanGVWMS2VDShL5XCrv1eVh0Kz8Gky/sbSdvlAXHrQ1leEDHIlGdRtL3yeYVZ6WD1MuTujgkhSeXIQZo/9+z1N7MZ9SP17Idg80PHo79ay1sWkANal6nUaNmNhQMCUgYEBASsXjOvVvEoBMYB93VL9QjSeeEyuKQUAoBqrjS2ejHKiamzB6Tjw5YB/VTNwbrP8QTIhg1xGBr8le4XPtIeH0KOR33u7OEKBwSdw+10n7qsG3usz/DR+en/Q9fR+aidCSe8vbJjSv1X14h62tiIAW1uXgj6Nu45cdOB+JEIjHLS4FX13EANIa+Yt9FC9BEdaYpwupMm8/V9ze7BqMu96PCGDXIQtJsKfS7hLHRY0vwdzKotldZa+wD/rmOcmbqmyEqpzTf6l1WDVL6IA1IYpf/Joiz93WQSU5dcfteRZ/TZxTxcQQggpQtZ2zgtmNaZeSiBkkEvQ3E/4PGtVFy4vxc3RBcBtwBEeXHDfDJLbjv1A//mYEhXV+tVaAHVa3EPd0JJ8LsAWhJLGwEQNo4Ano5xE9XZiP7L8fmsfT5A3XHQ/hZBBzke06SbB8zxO3REop5Srw9yg5IzHfMi+0VpUcCWjlfdODuovb29K2lP9qfqltZxvUpT2SR3Lydpq6vSJR1pIrXtfwe/iHbqpsws4tPvfW0IGORyBYsHDiyQVF2ZbMfnCIBcoO+clLyxzsApUDGS2wrZKrL7PcB8AbNWFvDZZqm1S8i1twmBXUfM5qh9LvaHQLB6uqlOELGtqCQUGHIkhZJCD0UP4e303yIR4xzwZ5URVWMCPF03MWk9R86sME92SZdlBGSAFyBqWeprFl2xEvfb00tbjH41yEjc9ysc+QNL1mZXFpg1XvSdkkEORbL9E6Cz/uQ7nPY/fq8qD14KP/Aj/Mc3BtD/j8UZ4vsbqI/h/cgCQjVF/Mi77wJBhpfJrLUBiYD1R3qn8uHGE7+hgC8XGXkwiZJADcQ1eCJ3lAkueJybJJ9uZWPe/yZP0l/1NHaYxD8qS3KDAb/XvNosAAApkefYwle0lFhGVnXUcjn47wUXU5DA/PTbpyriSYN35cCwhg5yGCYWEzvGv/RRe5X+bnIePZfU03Ggu8lzLZuI81STrzSoVU70Ks9JxA59sF+//1XHWNThJPNBQlGfyB5608GFNPbFlxwOxhAxyFEqMFDrHOdYRPEp/3EPmMpM3T+eLtaHyQVabbIHUhizfPUs7bTA/yy9PJRuyX7eo7qb7jsr3k/OIGh7k6yziz/X1JebtA2MIGeQYvBX87GCU7QzeZCtO1QPvLXz5zClOVoF6LNX1UD4s65ejUs8lUz5ZfxruGJmtzD+V3LO57CLxcGORy0TeVmt/bWgolXc4mUzIIGdghbXQp9in2/IVpTdufXGq4Tm+IqmlHCxL+bENWhTuVidrl0mwTjuISGU9Rh3pOIIGr3p7ZxuhLXRqXlH9QN4a+ffm2lSe8S8IGeQENBD6IHGkNU/3uCWszmPS5ylfxU7aVULU5gHrslXx/J31273pF6iKNcwJNkhp9LDPbs2zfy0nH20qdhrP3633b6e6Q+VN0YQMjB1Rsp1CrxjY8HISImljftMRvN3gmrCxkKTrc/bpe1k/0/BtaTAxkUoAAEpoGIiUaUJD8BPrQXTy/zQjH1V3L29HjlKCuphZ9LxHyMC4ESj+LWyGsU6T+BB7qZRsAG+XRcatdpf14TLxXio+oakLrVwweXx7aNC0poOPhmH8eThPQ/QZMT1n8uQTzcVOkz7x1q5RAeWh+qEUQgZGDMHdD9eY8fD6ft8KGvE2DI5e7Gw2jBPRnBUv0vpbMGj152tSjk7fmm5Gd/LydZqruPV5/oLTX24u8lwZTcjAWJHstFDYDJM8BuMfpC4zx3JXiUbELHKwGMONv15bd9X+4xXQ6r70VEzn/svkhgUj6ZYkcU81KLb6D2+t+2aIuc34L4QMjBOCux/ukmA/K/CikmwmX+ft45a7WEzgOJGKKuKrI47LCdB+7LGvO50AMD/dOjEozcN+csshz3hr398L8pjxt3RDyIBPCO5+WLYzbolbzH352kJIWOdmNjqco5Dkhm5fdfy8R4epfTNfQGsWQh1iUqDI/wpTdQ7y5huQsDKP+bhIQgbGB+/hwuZ3GTDHMYjtKhrP05mZpE0FZMO+cjdH+V1dP2+y0rUeYE3rEEdfJ2ZnPVJO+4nyL+Gtw8YudXBYk0TIwMjwDi4Im2H7SnjlhVV0OMtPSRUHvaT9MSy+r6V26/x9pauOH6PpHe/86854vPV2hKXlUN7WXCP9ZWXuEjIwLgjtfhgqwevV8NyjKE+utpd8qU44+spR8XzdD8z31PVrgOwDrVyo64xL9meph6gZb++C13XEo/4RMjAmCO1+ONkV60rfC6dq/HhJPGwEDR7gEHRbnp1P0IRSOqcqhejddVXPh8UOf/LBGlBqM0+eSIpNtoXvEzIwHvwx2S5ofrEOWI8ovXGrwsuu9rvOogp4XplvHLP1Fh6u21p3SGjFUAmRbGVVwOBuMqdp4fy09rfaJisIGRgNjoiEdT/cIf2Gk8q8KvBx4inSX1ZkPx7PnHBP32wP+PZppPPnlBId6Bm9cyS7MoZNcTQf84OX5k6ZLe6ZQMjASDCitLD51W6FcxzaxpkH95akNfhWwmN8C2a/496xje7fD4poXb0e6TyAdTH/c5aP5sc14JRl9V+EDIwDZUYImt076jhGaYskV/AX8XRxmX8kJlkJjRxpLEH6dcuG88o3p5XbbtEN9tO3Za5mI7/x0eQhBbzDCBkYAyJER+gpAQBAXScsNDQlTxJdtWcv/aXJInrtyKDwzxpBqzd07SM7uYou1nR8Kmpmt8J4Gm7TKlJLNw7dOXZFXrPhX9h2FR2q+OxV+CMuWYQMeF0yiKDfNYGzhlLyTUDYyEBRvWIyTeuiW/ifgyVlLzGw2mzkjpDRWoT0GZ/dE9Xq0SpSlLcvlwhkcavcTId+ZkkGOlTxo4znN1yyCBnwuGRQBlAqDacyMkKQRswIANK+gYwGgvSG0sDddHANQlCm9Iy80suQ8VLIlJ6Rr1KyNGySPsr4Jj1ZpikpZ0Cz8Cn/c3DdlJI5FOIqd76Y3m22xbK9jPoy0Luf4aNjU0532cavyWeS9VgBZ1WEl/D+iU+thAx4QrkRap0RpTZGZotk/oEyf8n8jhmGllQVly5RW46aC5X2Hss7BmUpnfq/gFQE6iz8rfKS0X9UR0Kc5K6i1tLTinv2t1bUakhP1H2nOtzixiSsdrWYEJGlI3BUxWdP33hcsggZ8IRks+3KjZGpfuWuCWljBKUBHGQwOLPsXGapvfDV8lLJUcOD6QMEhBBabvUbqY8fMuWB0juGVuF/9hbVfqbe+lzkbqLm01SLzbpsHwkCmjGEXrj7cAwLHbvIwWZ2NMKpCoTeOHZRIJzNRcgAO95AcPZkkMUiVL9jgAvwmhYZaLJB9ZFBrPM0ndalXN7sC5+02sZtL6LTA+jK3SOeRlct0l3ZP+Pbgqawj972XAM7/J1h5bg0Fp8qEELoWuq1cpiai5ABDzgq+gdAgwyU3tNchm7DS2uYdSCVVQtNOaoUKn1ksMEqSvO4E6lWRsW6tBX+elnZ+OhsxsbM5B6S+NMemcPR7B86Tj2hKS6mp2hCHEe7+DVOnvd/CZhUkYot4svYZBEy4APzPZTWCzJWakBp3UZ9OY/Tok6BqWpLSBlNnvZdemkgY+SY9mVmodJzLTck64qU8rsk8xvIrvA/e1INXupaNWMu95RsKG0PxkgIyv4hRemOtNW8xbIoZ/+Lb8NkBbenYFMxQqhHnnBssggZ8ICufkJW84m27XIWZbgNuMKZKLY65N2PuaanTHvR92YOBTo3Qu4XvaIt8bMf1ZuzA9HH3pLi+zFGS/xXrLFCL0ZOyIAeyo0Tsppz8yiwqbpvVUyFelFLNBx3RMCjsl4Mogg9AzozgBSvngxKsNfdYg7nSxBfdhCVP4nxXSBfQMjAgOG0WsjcqvbFJirJYTkWOXHTZOWxx/o/IBvA5B14F2g56O2QfGAgNHaORd6VnOngcTOohs/jO0B6j5CBwSJFtF/A3P5K92KTdZ7CckPC+cIWy7EH59ojGcJoPHwZaB0gTio4jNmsf6Tc9T/OV6Lergv1sXVhv7JJhAwMFT8EvXH1uOgnNlmDfTEICe8KLfHfurJDPJrZ3PgE0OuyKy0imZXk+xhzp0Wcwz1cqEy1xRQ/+6P5EkIGhopn8FzA3EaWwyfLcxqGXuuQ7xj+Wi6mxjNMsZui91y0zWLGdDfB0n4m54AVR0tI+uC5h2mxxUdCBgaKixAuYG7e47CJ+gyXuIoIbSwagv/Gx+QhIsaLGRusaT44xp35KPv3NDvzkRx9ElHKtgJmo3EM65LKNCVkYKAIFAt4Md5fEb738A5Tjm41Kasti17DX8eYFmYHGCdanocuf0l2sCjTv+Xu0u4hHCuWsNLZaiaGAHN3xAcIGRgm1lkLmNkFjMMQru37vKp0Cg9RQH9UdGARXmSmF90nu5ZlVazEbSWpZlyDu0bPsnZawT2CWZ9CiYQMDBJrhSSDuR74ZFUeyiV14mwTn8c81PCae6HXLJL5014MfcB2dqQ4XoFqzXV08HOMWf6tXIeSX8xWEzIgZNCqIzZRKeYbOaR+UMpsMQ9bXIoFkpaRbBL2bUD70VotWJfuaGlR55ccq/i5r6TEEY4yxjn/I2SQ68nAZRk2US8hmHXapJnSmu94qF54E+lSdu627drSfvSIiP2tLorAYpKeXJ2UX7ajKnHbjo6wnUXIILeTwSe4gU3WCWC9DxBS1mwZH6umB1082F4m1qAP/SGR5zAOZUzZUcCas49VcH1oyOlmlAVWPwkZGCIZ2AiX135pHDZZKx3ZDgvmm1R+zUPlvrWmekWyTVxpNP1nl9lw8imMnSIrw/mA1wVfqv0rDmVwnUDIwACxzlG4vMaUxyImJPBgUFAH7/vv3n1j3i1e+Jou4uEe8pT1NgU5XL9UbCaDQbbZJm5lfVXFbDXXw4OKw8Ul/dhfWLHA5i8hA8PDXrFwedUcgkXMUcjAWqZ9drGZzzMeanarnGQ0l/d1nmUMHu5RkWNpk2ZK2nI+wJS8xd1sLNu7USKtFhMyMDycg0jB8rJbh0VMnFkGGUQwS/mmmmwuD5sI37pRdbhRjMVmBg/fAM63wV5zqszd4yNhuaPNHJZeSGPyJBAyMDjcg3dCZfWTuwNxKtpKUqlA2p7Z0HalvMwj/NVKWGjhfojjWxYOMnm81EDOhX5bpAiGW+miZ1i6rGLVq7/JNhMyMDi8A8EOmF8HTLci7qXSBgbnmKR6X1syjQfXtxOeZrO4jrl/04l6lok1Fty9gn97e+O4r/bnKFOP7Wy2ZnoXVxAyMDREMetRXLDJCpOgv9JULnBlYIWKAMuSwfjr9LUltA/lLOU9MNqT/GPxPwwl96yDZaQe2kvizeLEySO4QsjA4EAnSDcejC+PS1ITMQCAdAr9FJ8aSMbjP4mg+J91ofMY5DwCZvt0fcpiyPSN5SQ8WnjehqrCvGdX7ETIwOBQdI5QOTXvgkvSZhEAAPWWdoJt1l638VfofXXJuFgcgq4As7vQ78EdDLn+T3IXkyLu1oUmD5m2oewnIQNDQ9NuQuXEZDNdN36JAUBUhfb8uC01MhZ/ffbblH6AR9IxYFi8cv1xjGvql8Y2bw+qIOrIzE06xmYhIQNDw+jKAmWUhDH+YU0RgGgLzYfPu7kF4a9O3CAYisuhcqeMYYKVdjjm+8+oo9jUoTjgJRmYeeyBRvisYYUVhAwMDGvtBcroNTzEJmu1GMCM3pJ6/BhR29/4a/OqjM1BbMLWMHUD/SE5hCPfJrVwkv1Gd7PxaY4fFyD7WdljuEbIwMAgmNfROYjCJusrBdLetJ58WtqSjx3ty3a+H/BJm1eIaQq/NjjyvQQvcColbqmDzbwYhJDCG2yy98LyHkTIwMDwEW4Lk9EWM4zCfCha7xXFStPKb3moy06TtjgXIcYzjhO72wQHhStcVuDVy59pFq5rE9B+CiTO2Qadnu+QSMjAwOAoUNyZhYUwCvsP8tKYcYY1kszkI0z/bGoM1jPQg2ozTRFjuR5Hxp2a4VZN+AhZoe0FRQBSj+wcnj9SJwgZGBiadRcmn5FVcEmK+fzkGDQ+Fxh4ICjoYvCzb9ocCA47FrrFQ0USe4nX4pXYuSXjJN1r4sh4ozX+E5yhPaQiAABpuWyurIuu0PBOUNDJwMBjQUE3g99HETLQP2YXFSaf9lynueFXts8Z4FfC1QTUIc9bpvmwhXtuq9jTv37Qi4+DsgmtLE5iFunHnI/PUTiuH7gGYfgVFOuQ6i4uqaFxyyPq1q75g/xKuMjUW1Hs6FW/z8xtl38SMtAbzlG/BcmnBvsIPYnBawfWcgQwLVK3x/QVO07cfPHubEQkQikRET/fPb12dOuySV2re0gB3BqM3PwsdQR/t4j9QT6qEd/U6jpumdWYqyY5zzwMGb+GB/g1NF+c1rslLdTGHe92jW3kDiArVLvH9JU7T91+/TEi4h9CcRERn9/dO7tnzax+DYuZATjWGbopJIWQgR4QJTojSD6F57JK9veIfzUzcKgzeM2lbNz0UkLPLu1bxQqs60+58G+OtN5XPmoR28gG/4JrqSnM04wujiHjv3AWe2UiLDPf9f0zFnYUDxa1cgGzCr2XnP2ke7Xnx8U1A2tYg3WjmVeSCBkIjRIzBMnGnPkWX8qdWTUkUt/huxkcs055uqlfKZGZeYunfFQipq4dD8ed8i9inuYBhGDIGfCfTJmgNPKnUsObRezt6QLunVYG0+7dKc839S4G1m02fCFkICiGVxMil7/AcACiuDnKDYoOPcbmuG74nu5uUGw6dj6Irun4kAfd2ASwSFRoNgZuA/wL+kuaepsBSNKWBP5D0buayeRNlrPwaPi8oY2dqPran4QMhMMZcYQAubxlNj39PN0dSs3hEHQT3RtXAEosx1q1P1WdQ/jQDcXGUXu0D/eMv/HkBfgpaM3Q2i4UiACqyE1a7mUdEi7pdHdrid+pFEIGAiHWLFCAXB4Dg5jEZ1uJXSdz9o5T3BlsbdYbX/CWmMquvFxZ/RdOsUh1heJ+l/wLeMJjk/+7MygPyEdz3DOMO1Cf8vzvDyEDYeDXU4BMrgHdBT3FMR+qzn483mnRAWWhMSZng4T6jq94Uc1nVvdJJGPwFrvG5x3cSRsLyLpi0f2rYVZ286IJGQiBFXkEOD92CmiS+7lyVIv7GDM+WxUa4JjoJ7e3vs+Pap4Cq8WNXvU557zSmb8G31dINuATLmGRUy0dOVz+QsiAwXT+Pv+ZBNJT5qd20Bx31NLzlSTDIznPOQbIL/GkmpvAasB/RMrZaa93I76a+10jqscHnAJ/jZeVuUPIgH+UF+CCmy0WdJ5abeF5Cn/eik0OLsc4ypggOcqXak4DqxlxrJzzvmDZSfzUSLHMrCT2pcmXdUT+iYQM+MZ/+fmfJ6xyoTEYbCWZGs9L7hG9qVGc4oEspHbyppq9FLt0LdtxzDheup+XCv1pJ5nDw4lExTarSqGEDHjGJxH/cSbmZ39o8YVH3qu85b/LqiKHDeud1Cr+VPM/lvFltlpyZM6zYl480T8U4asdX5e0v0nIgGfU5D/OxMTS2T1x37HOLx4L8NrLi/Ve3DUZnxOpuZ4sp9Fijo7kg2vzUZ1X7pXC+FJVTAfLy4QM+EWAUxLfWQzLrj2CrVrE81qC8HIFWDq3vnFsw+c8akwFlgl9/bkNu92W8jEucK0VzZ+uknvJrxEy4BW/TU7ynUV27fHDrWMyz0X44+vLim6iSlaI4bNcfRqwHW2V4ZTvfeAhClRMuTq8KkvRz+UrIQNe0a25nskguapvPO+1/O7Wh83LqKHbZ16L1aoDy4RBIk7zqsml+GC2Ajzfh5BQrUoyIQM+cUsUql8y2OD6RYBq3jNlMcYcIufZDaPWYJYJY00OcMg2Ke9/+Otyw5R3n5Uwlw2EDHhF2Yl6JYM/ztsEqeYEH8ZnXjZSh3kuVOkpbFOyphGEEDpkhn8vQVF5FP+NuMk1mpABn9jgmKBPMphSKusKHQAAZG0FSPsCUh9Raae0z1n+ziQdmz0My/3AbAZrs6FpP26s39CzvTi0SP2e9CsCAOrV0Vi5o/Lf9NtRvQEhy/9rbsTkIvPwkgGteuYiMoix2alHMlAUWKyliUDT1+mmpfwf0vG3Eno1ZlbsqEINk/kmA3PWNzvc4HDL/RvqNqOKAJ03Zbs2TNox87/0fyCzgZUbWg3Ti/NFBjrqmYvIAI2pxDMZNNTx4234qN2IIMNEAFRsJPP9gZRePWkptNjRaSmjsbGiVT4N5/rSCgJpWUNGESDz7QLKBUwtkVIyZcQD63lIouUO1g3iXw5lFhvUqoMAAKlWBNQaQlPniLXYw7Qd077JSgagndGfML38ZRCGeuYmMvgqu8AvGfjp+HGNE9JlRGmtqGwooDq6U7ItVbNSxw+4xKTUS2Q3kJZ3GqT3JVDpU8plVSEDUOkQygticJm1VhuzPn0ebrEhQ1NK/UCllGraBg2VU8VDTXfLa29HUJ76gWrLgo7hnUK2kykZcK9nbiIDNKCe/shgoqYrhZTmmupkoDb0VHnRqE1H1WG6nUGhr0mXaR1VKtsRZDEmAACND6a/kjLxHNiHZ1vszjblhPwJSJ1ZNVQnrSKgzK/KlVPFCYhh0o4ayCD9H9Cx8IOQxyKmZMC9nrmKDN5K7vBKBjV1/Dikjo6ZnGrb0CUDLS8V5LqSfpkj87dVsCSDbB5Unfizj+N8Fz6wS/jT4n+IFhlkqYjqd6rYI2PUjtrJAHSODFDZydjJINt65ioyQF1a8Cl9rK41iVleuo1Iqb2ykIHGNQStdpQoZrA13zlfpLb1JlC3qswpqYZpAqiYn9rb7hiwv7cxwXQPu4QT3BMyJ1TZdBJQXY3RMU04Dz+ZtKPaIo9qy+pidOeVTMmAez1zFxmEiEJ4lD7ZW8ePWy0U9IwI1HkAqS09ZWdHH4B+TMRdootaVp+VFxAzjBnSX2mZ61Hpi4mq0wS1cm015aDWKiNYJfuVOjBQmkerVie9/GorodktIL7RFPVWRzsCyjJrALVlBk35xDN1/RiEoZ65iwxQ27Y8Ctd5hPmz6LouI1JfhUZqU0pIf9kqb1trnm5uoH/1b6jNWPrV42Aqy1w5qHU0uxssx6cODHBbuCL/EobtCCrLi1nHfBob8bQ0gjEZcEYuI4OXUh5vZ1+eT9ev1YYLVMd6/eg+mVK7TIIgpjKtBIf67DNl4yz23nQ9PxY+yleIRuzN9GQXIQPmGFCbP9lrrXX9uts+UpAaPpM+pPvoEtNnwmh9WE0Oid/DXTZjwFI8nRB9LhUgnOZP60NMyYC4IzPGN/lp3mTv0jkzVlQZJUgNG9A+tvjabJlAWu/Yiktq2/XM01yEi7y9T+ryr7Dh1REhA/4xqXQKX6L361bmXclpAeq3zIpuDJ6UalVSBFJ6vb5cUrM4q5RcpjVvlflutZJvfZ1jvgdOyIAFouy38iX6BPzV+ftk69e8Vy9ITNtzbYXpC6GUXo5TSLWRzFcQ15m+568222Q8x9P86DAeETIQAiuc+Zq7XwbdN6qnNPN4x3PlrluPoT0Vt1gomM7dOIUV2GLBdAQT6TiJz+oM4+Vu2sypbLH6yYQMBEFSSb6W9Z9BNvcURlV1DeG1bqflXeiakaJuhWTBdG62hUvqh8B0RDU4bzSf1UlobsujK2uoZ1kWkZQIGbB7gUt5uoozDLILnx3TyO4ojzVbJRtE+x26RfZEMI1zvBY9TnyEWYJron38ViihveUBvmTfyufL5l5tQgbs0Lk6P4GAE7I/qJvQnxrFVyDEyJaSubQf/mk/WTiFhwI37w6PBczIw6sF3zVKHkaNSuRF8iqpH6vLpwgZsMMXy138CLbYlP0zu61K3+Ql84P53Bjc69HdM044hQfDG07pmzA7xTzJWoBgk/ssfHjwN/jYVLKA3ZuKkAFLLHHiJ7ytx2IaD72pR/XCf0v4m0ZUNwZxhC9SQQLq+xxEcko/qjKjJQZpgBCVelldMuIvXpFJC82LXmeZlpABW6WX6cKL3PL0doQC3aym4L1Y6cMAmTeT677iinQVUt+7pNzS/8+GyQi+fC2FILVSbLJ3Xh6LT17KziJmM1mH6SRkwBYPJcf4EFufpm9N9DwHy4n47ud63VfmsYHRfVHT7MKFVPcKZ27pLwID7lxk9kaoev0cI8+zCtN9Kkl7i4u7c7jxhZABa0xyi+JBaifaXrfRC52k7S/ieIMlHqxHFdrM7Oq4FyYbBdU2p3NKCKF3EEy/bmaLBKxZ2Agz29EYLm36PtdN3OklFwmEDFgjvlhfHqSOYNAg8burQdFZLznmeGdMHnGz0wx9chQ1qysE1fbgWhwJT3yQ7qMJ5X2TBa3br4Ueoobb/3AyxqMdTBzGf+BWDkIG7HFTcha/0AUFGT3+dHQ+KD3nMduOmXRznAcUn/GJccLNJs+FVbam6OKMQN+DcYLFG6FNKeVYGzOzNoEsh5oxZ3rbiOtv5by3Q8iAA/xd8V+OvtOEYQLFzRH5waXbDsYXvylermttDSWmsYkzGm4/RWBd1+3PUQDtWBCXxRv1YUx/tjcxlVSZdZuh60FKyNIGpuJqK79jKAIhAy5js1KtsMu8BD+YJ3qxqqkFuLZacJEuOX05Nb2RLTh22MTyrtSuheME1nVpruzThWZbReZvpS97ijk51BPMqo8/THO4//30zEbW4NJzL6YL4AgZcEGI6QbcIl9rio9HZ6J7e0WnggCOtQavOvZIu3GE3Tu4pG9laxCV6L3+MevTx+eo80KrOs8yjgJG04wu1Dnvb32a1Ifdw8pLwNK373+H72v1ZPkTcnz1oFr2ICrWe9NzfGs3hAw4YYX5K8wS4+A4+8Q/L6wZXMsZAOTFqzXvMWrWgoCA9YGBewMC1i6YPryrX5XCJgAi9wajNtzgtFoVU6in4Jo24Xrl7KJCtB7bJTzPZUHs3U3+DfJRAPLi1Vv08p+7OCBgS2Dg9oCApQvG9W1dy9sGAJxqD153BfN2FiEDTlA0roD7Jla7/3Hmk2CrITOGd/Wr7FXQ1tYGQGRr61CwRLXmPUbO3XH1PQZ3+HGOv4RW9B/guli7RU7rxWw92lBsK+Htxa0zhnVp7Fs4v62tOYCpra1bQZ8GHQdPXX/meSwfORIy4IYwpxGYJZaaylnEZLsoPuv8ULJLcD2/Bq5e/KeAhmtPYpVS8bnXmAkZcMQZyX68Ahv34irhhzmvIUeSyjcUXs3X4RtHCfeAhmOPv/lzRMiAkAFbTMMciKw/51iZI1xj+KzwXIv3wmv5IHCd3ryn4YJ4mNqBCBkQMmCN5PplsE7gFhTgKCDUZA2f9X1qsloPWl7nwFXCz+wvln5nPQARMiBkwGVUnrcPTnEHxBzfgX08EnisbVL5ugo9KHmGF1cJ8ZDdwbL4cuXiCBkQMuCEa5L1GKU9Am67lS8l2/msrF4mCQgN5n5xjSy7Zc8B1u8QIQNCBtywHGfc679wilP6DsX5PGXzWLZWLypu046zCLtsSr6LOoQIGRAy4Ipejp/xCXNexSX1A15NOrZEPYVeNFydezhqd917LM/NRyNCBoQMOCOhUjl8C/hVRnJJ7efDZ28dZP9VPxouMos7GczX9WtM8aoJhAwIGWDAN7eO2Ppgt6YcEl+DczxW8wh1TE8KtuF+CKSwLjJQtHX8hAgZEDLAgTtm83CJmlGcQ+KaNXms5Bf7IXpSb3z2EeSzhbcuMpgtu0yMmJABJuwU7cQkaZcsiXXa03CTvyom1/bW19bbJ463JiCEkLeOyxqPi1YREyZkgA3zZRfwCHoErF1iFT5NeazhOPlTfSmXli8xezJ4Yd2HGDAhA4zoYYsnWlacmPW1W/tFj/irXyC1U2+6PQncF2i9p2n7JapI5QRiv4QMMCKhjiee4OGF2a6cJxfvwF/1QsxH6U+3m824yyikbc0guYnbN2K+hAywIsrbF8sGY0u2XXqL5DVvlYv0rJWsP9Uu8OAuw13bXVUTTW4T4yVkgBmf3RrgGG5O8mY5NPHoy1vVkhvnC9ejZkdV5C7DSYsH4j5qCzFdQgbY8cSmCwZ3A7bbCatM+dsqHyQP1qdiO7fgLsN6ncavH8lHEMMlZMADbssx7MSz3E6IcRnJW73mi4/qVa91BnKXId2j6dvvbnWSid0SMuADR2XzOcuIE7MKnjTf8gdftdpJrdWvWovO5CziL5zRxKC+nr+I1RIy4KvfcHdfKcbmjoAoW97uNbkgm6BnrVpyv9fkA9zJ+qWijeMbYrOEDPjCcmoTVxFdGrNIxF8U1CfWXRT61ek/OMFZxgPQ0O0n4PIUI2RAyEDz/Ho3RwlLXJmn4S8K6hu3Ovp2yWF7s4wyzmu4k30z7CT2SsiAT0yjf+GvlmE5i1DAvEVBfetWIUrfGr0E3K8SDJSkGN70h5BBjoe/jFuwogjmwY54i4L61s1H71yA9khSOMv4L1+WIY9NRwUxVkIG/EIx1OQ4JwEes5mm4CsK6rt85SP1r9ClbtxljKyq9kW4p28MsVVCBryzwRAZp5lC6zYME9CIggpsmuu9e/kIQxhqVaBXMwBQr1/Gp9ZqTt4JNQqEE0slZCAAG/hL9nBIPrsgwwQ0oqCyIYN3+csZAhdk44CoUjPQ9mOFsaot1MX6CbFTQgaCYKKYw7XBp4DZS+sBdQghAEBp/0LGSzL9VZn2OfPNmdpx0h9MS6yGYJfyvw1CmTAwrTZq9UMAgFRrBqmPIdXaIoScV6qInCA+R4yUkIFAmClif5vCb4rZmoOfjyKjJ6RRgBIVZPyS+QhSf1BTM56zbBBtGLpUIza1YqvULPMX5doiFKW6KLsW1hITJWQgGBZQ7O8hKzqNydPX4Jz6C1+ts2S8VQE0Ppj+plXGTllXQwn5ARuVGUtD/dJqpjQ+UK0tQjfgo5LAo+JZxEAJGQiIZdQitkm71WfydM2aiB4ZKDWXpgdVsIQaYygbb//gZHZkkKVmqt8htMlcqTa35YOIeRIyEBRrqTksU662ZrCxnhoFNWvHV5omgKZpAqj0KtWRgWIktcxg9PgagAYZKNcs6zTB3ydT3hvH5uSkIiEDgbFRPJldwmCgH3s0PQqqygJiepdI+y6dGCBjSJ32ZeY0QaUZo1vJ9hqOGi/B94y1QJX6pVdIbWlU0wJik64Z4oiDASEDfWCHeBird1CSfAvtZ3VEQWXbMm9KOl0xIC3uAe4OiC4ZU7YYX0/iYEDIQA84ZNaW1V0D1QfQfVJXFFSWLXPGtpxBXS+0lLuFfYL0S1KSm5NTy4QM9IPrdjXZ+O2Mp32tEvYoqIoF4q5xBqXDkZU5i9gvTtslVXSRk/CnhAz0hGf5S7J4zR6nftJ7EHsU1H8dJcsMTIUY7mMflx5kdoKeA7gRMsjV+FIqXwjjRBGiw/QexB0F9X1ph/OGpsEK/pxF1Ey7Mmkt9T9ikYQM9IfI2rbMl+NK0esAuKOg7rEu88HgFOi6nKuERPPUuGkbxPOJPRIy0Cfi25syvjFtaAVaj+GNghrdixoaZ3DqS6AOchVxC14ihOJHwQxijYQM9IuUEWKmYVL3SeicC8AbBTW4iIMhTqjfwV2uIua7IIROe1ruJbZIyEDvWExNYObc+w3O0ngKZxRUxWJZ3a+GqLvL3IOeNe6A3rWGtqHEEAkZGAB2mrT6xyhB4UnZP4MzCuq3+tIFKQapuh0mXA9JJFtN6igucpZYISEDw8A1pzKM1v0H0NhcxxgFdYttobsGqrl5hbjO0lYBlNlDjiMQMjAYfPB2ucng8b2SP9k9gi8K6seGopH/DFVxA2tzSv52qjslPUPsj5CBISG6uekO+k//pI5l9wiuKKiK1ZbFbhqu3vy6sU8bsbUOlWdq3dbE+ggZGBZSxsFE+tPy0tl5ENCIgkoLr2pIJscbsNpKsTz6iX4ENJDK259MTrFdQYyPkIGhYZtJS9qRxEZ5I4TCD2l/gEYUVBpIWGhW5qFBK82WldPgi6U1xVadD8QghB7CI2J6hAwMDjecStPd3zpBnZ1eBjQqd38kSouCyhnnvMzmJhn27ApOMk5yZGABcOl9Im28s8I2hVgeIQPDQ2hpp2t0nvu9t5MJSAE0Bk0HmP8P+flwD0sW2hpafTRwjT0DRjHN46/MqCWT1Jj3IFM7rZsTuyNkYJAvupbS7F3ttziJKQkAAFTR8GsigNh+JHCO9R0/x6zwaYNX2FmIpD3luTarjhl49jug4oqlcFhCzI6QgUFCMU/cKbuFg8uQDj8Nv74EABBZbuW4ZHDS02JeguHra4MVrcfCj46vbgYFe2//rP7LU7hHrI6QgYEiyLHkq2wemShO5QJRFw0/HgcAAIry3M9hovCwEbQ3CvfcaSWyeyI5JKBHERCV7L9NY4XWWBF/I0IGhrtwUNHqsO4nEstIAQBAqimm93+yNKaAimw9hUJ7iSpcMg5ldfPTxQNPtw2vZgGW9aad1npKo30TYnGEDAwX8QOpCbpfV6/MAADAZIKG3wamLieAGE6wyz5yolnB3cZyHXm1YZq/T3qyZVgVOZj6Dt70SJcuFc4LicERMjBkbDGtoztG70YKAMBkroafqqdygcScXQjjhBUODksSjEZTeZZl5YFHm4ZUkoO88tDNj7PdFw0hSwaEDAwcDz3y3dL5QEspAMg0xUFwTuUC2/ts8k3aVtBsTKTx6CmWOqL88efFVQN8TcG86rCtIfT8I5YTLwNCBoaOiCbSJbqG6r+dxACa7nKOoQAApC4vWGSasrOIpLdRHevPcDOIurl+eF1nAPtaI7Y/ZbAk2IwcTCBkYPBQLJA00TVVuEABwOGs3z8GAJB6sHAWStlXTNL9rXFp6QRExwZvG9c4P4Blpb7LgsKYjoSsVhNTI2Rg+LiVP+9FHT+PFQNcyPr1fgpAWoJ59B/FQW9Rl5dGpaCYh3sbmniKwbRstwUnP7AScRNeEEMjZGAEiGwtnqZ9xJtQSqRp8WueCUgqMp71J+8uLWr/zFgUk/Lh7Koh9dwpkNrbzzrwmoOjwBw3YmaEDIwDa0xrftH64wuAl+jfi9tBpwMPBV1++DW1T/QEST2mEY7iAwqJOz0xBoVE3N42qW0pUwDHan0WHn6R0KIzN3m1uhEjI2RgJHjk5aDNW+BjYA0oYgGZEOepPnDNNYDWDDcG/y7JY9Lf0NcK4l8cXtinmiOASam2k7bdTr+UznsyJ6mxJtuJjREyMBZE96RGZL2s4Ofm7vlBWiLvpM0nn4RG/EVJET9eXw9cPqyOI4D5lBtMdst+Trez9P9quAqIuLdvXp/a7iKg3OsNXnHmvWrdLDZyEn4OPhMTI2RgPNhpVVI1+sbvlXXElk0X30lEv7I+/bLZ0BKQZxBdh6Pn/U3tZ/w2xGorPl3eNKmjjx2AxKPegIUHHmqa+/yAS5wyGe9F7IuQgTHhQ3WTRZnvwxvdTK17HdV6s1EyQujNQl8otlyzN36C0hqEIqgxVXRtjIFVN+75iRXD/YqZAJiXaum/9sybRO3P3gJu8RZ8BhPzImRgVEiZL6uV5gp0qSZU3ESj+z4aZGU9XcNt778L9MyYhW/2htrHDMf/LvbZqXXjO1RyBQCnyl2nbbtOw2dgt5TTkcMI8UFiXYQMjAwPilvvRAg9qw11r9FM8me2nfUSdZfc1wUAUqnk82RnWfeHhlC3f09PrhnbztcZAGzLthyx/Mgj2oEg0VxPTlkfFEUQ2yJkYGyIHU51+DpW6nONQZo/U81Kqj5/2UoCom0IKc63FrtM0fOqYWTI8VX+bSs4AoB9+VajVhx7zPwyuD4NORVhiA+xLEIGRoizTo42axkO6t80Fk9VGhxskYgARFX+rPKCanv0dTAx9uX5rTP7NSxuAQCOPm38Vx1/8pe1sFoDOZWl0ARiV4QMjBBbTKqx2AYLkFdPv5VdMTHVHYHKa95f+ODgSZ+u71k4rHk5JwAwK1q35/SNZ55xv6XJfRGX1G/gGrErQgbGh5nUVFZrZSFFPVP9iWJbi1LJQNolUrhiJ4ZeD1zm37FKXjGAxL1a53Erjz74iU16TPb3SunCCutEYliEDIwOw6RsXeV+V3F+jhAKKydJ91R05P8mhL/PgrbOGdysvAsFIMpToeXwJftufMEfa/AhcDpZ5deWGBYhA6PDbBn7oOWxTdw+o6du0ky/5WM8lTLlW/DR1ZO71ytmAQBmnjW6jF1x4OZnHqlnj5SL8FizDcSyCBkYG7aLuVyPFONb6pi5ROkQQ2XMFHD/+PoZA5r55BEDgL23X98ZG06G/BJk7sTJgfAsfCGmRcjAyPDGciWn9BFOAFKpVJTBBt9xU4BVsdpdxyzbc/VNnKCK6cTpMqTh3sS0CBkYGVJ8W3ITENxd1H3BmoBdgSeDbgQ/ffclgvW6WcTzy3uWT+rpV06FAl7ry6O53Hguqb3GE9siZGBskwQnzieJZhfhMLn++/Lq/pVT+zSrmM8EAMSupRp3H6dPCsiExSYOid/BRWJbhAyMC3Hua/QgI+btjcOrpw9oUbmAGQBQziXrdx29ZPvZJ98NKJjwJ7jOIfVaS7KxSMjAyLDWFYPRrs5DZ2gQ9/HW0YCZQ1pXLWwOAGBfvHbnkQu2nnr4zTCvZT8PXJYp/VoS2yJkYGQoj2NqG2GmbT8x/vPD0zuWTuzdvLKnJQCAtVeN9sNnbz5+77PB36Syxp5D4niLAGJbhAyMC8/gqQalAgBkVS6k/qRJTPt2yh3hy8PTO5ZN6t28cmFLAABZ3tINu4ycs/HordA4I1LNsKocEp+DUPq2m6puyNWGTcjAAF5/jtqUCpq+Bi0qX+345dGZHcsm9WlepbAVAIAsT+kGXUbO2XDkxqs/Rqqahr05JB7pzcB2NWmVkAEhA6HRtYUOMoB0M80YKGgjg4dpBFC/y4g5G45cfxWVA1STfwGHxB6TU3UI6WpMe/mnj7kA0r6BDK2qapuQASEDoVFplE4ySDNkpY+aVf4Xlr6KzFmaiREdZZ/4IdxNHf9nEkLaX0ocq0QDGR9VviNkQMhASBSZjXSuGaiRgbY1AyTbmdM085jLbUgz8ioyx/+g/JcaGUDaGEGJaNO+I2RAyEBguK3QoVRV89Q1MkDWqovnOeDu4b0SDnuuZQcjemSgpG9QWT3IdWRQh5CBvlFymm4yUDJZXWSQQu1P++PdiUW9XSHM+DUzrTj7tB/hHFKaJugmA8js/rl4mtC5JSEDfaPWYJpkoHtkEA6Xkl4dmtfV2xRAJoGc0CqtOrBPuzwtrknmegFSGltlrBGqLhbm7gVEv+6EDPSM5B5VdJKB+m6CljWD0B4glgDIxGnnFqvnANV4zGOftnZnYp0MUX0oIQO94e/JyX5FrSiQYfEE7AHKkI3IAfqhTrBO+1scSKyTITznETIQHopX63pUcJICgMi6qN9I6RkcQquM3OSQGeBEPF9h9Gq6ScOFUBu2mvwldsYMseKjhAyEZIGPQTObFbWiAEBeoPbwXanG3rY9BtHP4QmKnizLjH1m12j6qd9Gra21duzTtmxCrI0hHsAbQgaCIP5J4Iwm+SUAQFl6tZh9Qzl26HmTb9wzGF4NIYRCu1CpowPq0soungBFuq66a7TneAfVZP+Wk68nNscQ281SCBnwjIibm8Y2dRcBRYHEo+V/wRoOCtXrzzmXDyZpJ/8fVAMRAORDCKGfJ6Y1tAHTKuNO/zNGzVUZxjrpYVEYsTyG6NsAETLgDaFnVwys5QwgtZSCSemBmx5pe0c/lN3iOv9o2irj70P5xUC1yPjlxdZBxUFWbfrleGObU1luZJ22Y01ifkzhtpSQAQ9IeXNwTtfy5gC2RYo6U1Ckx/8e6b5SYLgHx3OFq60+ZH5IWGIBU1R+/rarT0GQ15t3O8mItPge7rBN+s/8f8QKGeIJF99vQgaa8O3cf7185CAq2KRXl1r2YF5r8rHw7FPFlWrO6QKSK6a7VD7/9s+6MPxhU1dXsGq6/I2xqPKwmPXkZrf0JzFFhphbGBEywIXomwFDa9sDONcbtfHw6s6uYN1sWTDdN/Fzm94ctgKfWA+mmc2aNnZQZNT5BGNQ6MyirJM29yP2yHRSVmgBIQMc+HJiXvsiIrCq3H/lhZ9R+3q5g3mjBXcZvetvyweyHhs8cGEwrki+Mt4bLNvsiDR4rbZlfTdahGw76d0MEST7QciAG5JCdoyt7wjg0XzaofcIodf/1ZFKas26xnw774xFq1h2ZThn2ZThm/7D2kYmskYBPwxbt56z2abcKCceR4yptz0iZMCeBx5vHlLJFGTleiy7FIkQQokXRhcGx257WYYYuutU9hWLZCkLpH1YjCn+7GpjLq652oD54B/7yCZ1yX2rTPFaeo+QASskh2wdWlkO8spDt6ZvFyYe72wNpSbe4LAO+L6ixWbGib42MGG7IxR7uKu1uOE2Q42PeBves0wZxuniytyJjq0QIQPGeLdzeFVzMK00ZPOTjNXBlEv97US1137kKDpxrKj2c2ajk2VWhbkweuyB1qZmbY4YpI/iake2KZdbxZHezQyPJE8JGTDC3wtzmjmCtOKgjY+Udwnujs4LFZd9xfI2LCcb/pD23p/iUAmTqbEcs4za3EDsNOqJ4Wm7azO2KSv3JL2bGRR1eiBCBrRn5k839SspBvf2y26oOvJ9nlUYSsx5hy2fNVbUAHrD48TA0qJCvuEYMv26wBMqBRhaNGXPmWzHbtQZ0r2ZYZNtGCEDWoi/OreRNZjXGHdI/TxR8tGmYtfxjzHm9bIKiN1FjQ5nO3D/ONlV3O7Jo4L5sKz7KK70tDDrHWxIWv+VFraMOWY5J5HuzQhhtpsRIYPsZwanJ1U3gXxd1jzIamC/F+QTNTqIc76dMFMqhl3Jx/xEtl0P69gdezbPh8oz7RNC6FcD0y148o5eXwYq7TCc8wunRCyHKikFyEXsDF8FTespCBnoxo+DI8qJoVi/7RoXBl8OkNuM/Yg1w+uFxQAm/xBCX9fVk0gqjgl8loWCfl1a0c4Z3IZdTNu2SJ5ADcbFR9c6yhwnfTIQ7U8rxjJhEPWS9G9GmGf9HhEy0PGePD6yJCUuP/Kglo34R+1ERdfgPRccNZASA0jTb0yMPD6mohRkJRr3nLokYFPg7oDVc0e0q+oC4Npu1RNlIj9gUfUbrjKEzcor7WoYi4n12a4CdqhOujcjXJBg3InNaWSQeG16NYmo7NhTWgfqd5tSZQ9ivpfgkKMUAIBSbpjEp3un92ri7W5rCRJbp8JV241YeSHriuGzInlu4Kv8dm+q4UUDGLrasTx3+MtkG+nfTPDZeSwiZKDRBp8s87OAgv336Tj19qYDVekE5giDX5qCCAAAzFnM2iObmmA8sas4XRvK79P3FSwv4RG7hMusY0gHZzIg9a6VTMggK2KO9MsDDu3X69wo/D1EVhy3g1vKanla7EJpD1bpp1N9cC79BbcXlQzULx1skbPcEvAeSDo4E5v39ca6p5wzyODjmsam4irzHujuA4otDq7rse9cjcoMcc5yi/yYdcXPOEv0rIOo1CF9xlceVINduttwj/Rw+khu7obVbnIAGSTfmOgN1h22ZxsR43k18TAenHMSBqRzgTVbonlVzOky1jKFtBOVOaq/Jik/jl26/qVJD2dgeG2tMS8XGzkZJJ3t4wBF/S9k3w0Vq8wq3OdpVCwVAwBIB7GW8Le1dDneMj1pQ9W8padGiZEcZJUu2nIV6eL0uaC5HW5HM2Mmg+TzAxyoqv/ROg4Q1kAygzfftiuWUgAADm93xVxxO8wnEG/VoDqF6qVdrgC70etm09+kj9NFbCPHh4iQQSpSLg12pnyX0nSzuZO3yB3+yjLUvqoYwInTqt1Fl8KPMRfrkKfMP1IPTbPQnV26st1JH6eL8MouzxAhg9TOPcwVfBZ/oPv4NtNmPJ78vyvemjyOgtHcpIRVl2/BPZJc4+CwVfiVxMbsOvUleEA6OU28KFT4LSJkgBD6vdIbvOcz8MJcSE3hca8tuVwtBUJ7gevQI2k81TMWc9kih4mrhwjcPEmW7EitfS3SyWnisl1NPmZURkcGiktdTK37M1o6mSHezGeJVpu8QAghDFHMT9iUeY27dPcrSMZFC9pCt+ADm2ShkiOkl9PDcmlXXg6lGRkZfFtQCKpsYXauYL5kD59FinUZg03Wex+rQNzlS1ln435MyDaaX4BVsjHuyaSb00F0O8lCfuZ+RkUGt9tJHUc9Z5hot+gAr4VabBGOT1j8YBiFPY7Zj67QQ8DoJw17sDJxm8Wkn9NBiJfLJZ5EGw8ZJO+vAhX3MB4e3ZPP57VY/5wmYZW306IS/g3Bo875zgnVTonmrJYMVlpEko5OY5a8Wl79G8rlZJC0pbCo9XXm6eK8+vI8KLbCvJTzooTDWeyl/NmeGiTQZc7svAxSPIeRnp49vjaUTOcvFJRxkEHCBg9pb1Z7KeM8+e0DKfknYp8TdhFNxT99DnQoJIxH4sSSbFIdE70hXT37RrQrcptH8cZABooDnrIBH1glfSK9xm/Zzok+4BcaYFo3HLvQ702kS4XwOSjnz2qhoQXp6tnhS0tqIK9HvI2ADG5WErH2q23TgefCdarDh9R7HnnxxyhRLJC05H9e/oNiszrxgLpEOns2Y9DVVp7n+c3C4MngZy+qNmvPtGfix/yWLkLtOnVciGwj5mGqcDWvB+9nhHeYsdkCb12V9HbdeFRZOjEW5W4y2OKQh8POe/96PBdvkzVfDbTWtDr+8KbhDXCGVdKIzmwuVH9CnSbdXecrcbCkMv/hLQ2bDH62FA/ncKggxXk1zwVs34430U+87PGHJEiZTo3g1bcn0W4li1QdKpD+rgNJq21cNwkQvMqgyeB8HvcrXNLfoD7zW8AUuwD+hMf0pobj9zrda9aYzyvPz1MslndeiI6THq8dJ4rLxgviUW7IZLBM3CGSk4D/8vFcwldsI3/Swy6rctjPKqA7Lt48hjkYWp5Fom5lFaTLa8PN6tBKoG1XwyWDxH6ihRxFDOL7HNxuM34vA3vjY4H/jFWotxNvHgcKt9nME71lGRkpN+BZCxAuYpXBkkFSWwvOU+YGfXgu5IxiPGeQMFbUNgK30Oim8rM8lfcesLgdvHdJMjDQjOddRGVOCZcdGCwXmF/lLKTGIJ5L2bcB74o4nzcfdpeD5G4yno4LTyrMPM0H6W7S7TUhpKOoxF4hg94bKBko2plf4S7Fj+dzCahVZ/5V8au1aALug4yKgTJeluwUBScwTzSgaArp+FnxsK3IW+D7LwyUDCaYXKFbcAAA9XqkfWrRgYECdMjRzjadtT4IqfJwYIO5zyu2zaqlVop+phcYi8r+2evAPKzSa+kO0vOzIKgBlBX87gvDJIPt1E5GNgqafxxfjqGtA0PttOim40F8qn3lY76eLRloqVVyF7pB95mQwaAyzCvXtjQZGKjPkXeXgXpnhM/XIMngpmwSQghQ6ksNEEp7vaW9bAEg7Zv0tx6kPoaUv0MI7TVJwiJHK3o1Sn37pifMkJ/ZDzO+zcwz/QlQK5fKEyqZJ04QNfuu3nDcapVQxzM8Y/CA1ISkC88YWWQqI0OgUrJ0JDgsYtzWt6izpPerIGJxfknHh/rI2RDJ4I9HS0VqH1O2ytQ+l2HXSoae8VHlO4TQa7iPRY5WTC6d3sdU5Wd0ZsgqXrkbq5Yry79KuObhsF9tGsKxVuGetRNUOEtZiDZRmnNLx1HRF8aNXb0e6f7KeNxPbjP6o37yNkQy6Jb3t7qVZlolqLxxAZRmxZAxVU+vldc0PHK0Ya9Jkkb5Kv+hDFGptIGUXtOglllGllny/tsfukaoNRy3WoVYD8y0AC1CVERpeBCprIy0YN6xj4nuEwLIHAEerA3F1/7TV/YGSAa7RRdomjtSN2bV7xCa6YlHjja8g+DsyUDtXa9xJKBaX82jkhOuyrHLMNTqmPh/NMkA6WaNNIRKGJ8pSyrehVBAOl6McRK3PK9HnwvDI4Nfjv4qA2Hd5q70wtIwvH8F17HI0QqvWRnTBKRxmoBUfwf12X4WugAtq34Iod/tqCExatMETrWaY/Zcw3QiawHVRankljkymOLKeAt0g8kHQgIIIYSiN1eGQrO/6rUMhkcG/fPHqC6RKS2qgdIqmPq6lsaFv9oN8cjRhrGlMxcQkcYFROXfQX0BUS1d5hNast5jW/g6wqedlJo+iWoLiOl9XKmAyguckFlqUKY5hBBKcJ3KtK1j8owiNIAQQjd7W5h1uaRvR0yDI4NboqMYi3YZbvBaxefUFRYqBdYN86WxaPg/fA330WoqPqvYJ2EcgGGODblqFaEfS7yg/Joo/RfE0MhAUa4p1qLVqsNvFRvU54cMtD6y1dbjIr6G2yq+hcsqFOXbMk0SZrUg1zNB7MEWUruhjw2iLIZGBnvFeC+XvSni17/tJnVKYA2FtaQG4LtFtrUnrhCbJynG+wLdPeJyNxMkHOtiKW20J95AimNgZJDk1ROzxKF2P3gtcccCf4RW0l6nfNgY6Kf9VEySqjZhmuIqdTQ3M0HSmd624toBvwynRAZGBhtNcPtbRHu05bXE3106Ck7s4Z2gB67J9lrT91jkXIIbTDtDab/cywQpFwc4iKqtCjOoQhkWGaR44j90fJbiNwboGald3wNCr/4cyeO4Dc/ac3KZpjjEKCrVZZpkhenb3MoE14e7QsWlnw2tXIZFBgf4uFdnuuwCr4X+vrCyWFJl2oVYITUVOUxU8zkWSTepExik7BA/ZJgizHpqrmSCmGP9XKDM/PcGWDTDIoNKfAzpFZ2sb/Nc7t97+xYEkxrTLwpICPfKyyZhya5HYe7znOi8/ZgmyZWrh2EbmssltZYY6JDIoMjgJvAS7i2hpZUAJ+NCt/UqCCY1pl8SysaTV1gXPInDQOUrOcuYbMP0PrhcuHr4eK6vyLr9DsN1rTAoMuhZjh+5iX0lAYJUIHRbz9QRgjBnTb61h7ZfuIsZ58J1e/GV6TKGKXLb6mFC0HAPKDDsXIIhF9KQyCDSbB1foudTY5MFqkXotp4FQOo76tAPATI7U8hyOecAzb+sFnETkFypAtNC5KrVwzdrWliLKs55ZOjlNCQyWG3B35b9frOqAlrfp91DSougSO9Nr/jOKXaarOwdrkKmOnC7V2WeKVNPsc+W03IJEUQcGOABdu03fDOCshoSGVTswaPwkNKW6wWtTdSpyTXNwKnV0tuJvObzso6oN0dLi7SdzSX5Y9l/TJM09soNq4dJV6dWEstqzr1rJIHdDIgM3sI5PsUnjBc3FZqeE28uaeEI5rWmneHzSrPd7haLuM1FZ9tyuL4rvnQNpsa+Q3QjxzPB61UtLMFr+Ilo4ymyYZDBPPfpl+LmOPF7PRG6VtBigR4WcJ5v7FEYxGWG7f3CVw6xM808D3MaGlhw2FDoY8d0z/yH3YicTQQv13dxA4cOGz8ZV7ENgwzWgAxkeSpf47mrxs4y89TPFZ9hB0b6SMCj6/9C+DmzHtqJasTlhNcwT9Yj2U0ixtept/WIzrE8oHi6uoMLWDdddM/4gj4bBhkcAACgZGBSfg6/5zZCO0KjJ3qq5L/zM+tZgl3TBdf4OMxwuaxkRCTr1G9E+1imDDadwTTJISooZxJBysPlrR3AvsWy+8lGWX7DIINrkA5bnqcK6FI5UbsQvVU0KXhFO1cwqTb+OHbXk5SNDg5rWBth60rs0oUXaMx0rBPh2icHEkHi7SXNbMGp7aonxnsNhGGQwet0LpDw/9pWHCol6vBCn7V9t7V/MYoqOWAHZv/0SH9Z2Uss095i5/wZ4+vJ+F7YnnkicxgRfDnoX8UE8nRa99y462EYZPAnjQvEMwWZ1gWWFHUM1m+Nfx0dW8UE8nZY+RDniPJFI2jOcumgTC8WiZKbOzI+WXaWOpKDeCDx9rJO7iApP2znO+OvjIFsLcpSxwUlEoXJLmVvWah1VN/judirc/2swbLetNP4Nh7PlJUMZLWBulbO4hj2IDnjI2B/83fMKUTw9ZB/FTNwab7g6r+cUSEDIQPX1IHBQ+FyvOgnKro2Ru8VTwlZ07UgiEsP3oHpzZKyyd1iNovF+ij5WsZp5oqZHzbq7fgjB3SbiKD5bdxBUn7ojnco58BAyKAMAIBYWBfVl/3N7Ea+MITahx3yr2ICLq2W3MCxzxA7x9p1E/N12F6ML01dRjE//nUIjP2wYtTFRR0KARRos/DKP5SzYCBk0BQAJF5CewT9XOQJNXcbRjjK+BtLWrmASRX/Q9xDYf0cLCnOePP/OjBcRvkftYw57Tka807C3yv/dS5CQb6Wc878RDkQBkIGfSQAIj2s6SmC2kodxjw1lNZ4t2NQSREU7LrmEcdlxTetoPYDhmmKjmD0+GaKeZxzRZNCRupuFH5+SddiIsjTbObJ7yinwkDIYIoJiCfpJ+vv8wpB+eWGM5GNOj2tniVY1pt2mlNgxRuVRF2YzWdnujBhoADxDOaFWiu+aXQ9JPnFvglN8gLk9Zt27CvK0TAQMlghFRfR23BdcaWftbRZYLwBGeCjNV0Lgsiby7KiIrCwbAiTjYU3TA6KLaFY7AK/Mp9iVJ3jz/U1/SrKQVq625LzP1HOh4GQQSDAHX3mH7uvicSm58lEQ2oazsuKSevdzCdGpnf1vtl6Clakf2fFDBbrBSixQoVEI+kWic8Cp7cuRIFd3ZFbHyagXAJ9k0HCp+ALQQcCF0Lzt7H6LcmP5VUouz5n+XaHRt8fXws6Gngi6MZTGr57HJcVYxc72C5I1Ws7GJwdG/xn9TL4QtDhwGNBl4M/6SKglFHijSxKM03+0ghmBa8Ozu5QUgYSr/ZzTnxCuQr6I4OoM4t7VXAGJdiW7jj3qD6XZz4tqUg59D/D05sg+f6GkfXyy5QqbObpN35H9h6D73YMLs12WTFqqoXr2gSEXoqAGqP1qX9X1o1qVESu3BhgU6zl+E13Nekirq0Jm2NNt8RrDLorpLw7Oq9LWRMQe7aavOdxAsp90A8ZxJ8cWVYM+RuPXXXk1rtfESnow9n3948HTG5dWAxe/fb+0Z8+PiwsT1l33Ic9FknIgsaWYF2l/+KdV15+i4hHMRFfngVtm9ejvBk4tVn1IftOzXpZ8cdwWaGdKR2kAJTGJb/wnQNLi8G+cu85W04Ev/sVkYjiIn68u3V0/czO5S3BpMrII2obAL+q2l5moYFoz8YKA+0E8Y8D53Qubw5UwabjdzyIRbkVeiCDxIMdrMSVJ57S2OVjrsyqb2rit0mPO1ChK+tKTJoEYLz5KmR8Ycjfa6vGIIwpT1d3cILy80JpDC1SlxVL9me4rPixh6gEBQAAS9R/ej6rslheZ/IxbeOxD/tGVpHI6i9TGi+/LVyA1Xmcbo5hhmf+Py4FjG5cUAQSz2ZjN9/9h3I3BCeDj5NcxI036NzJ+7u3g5nVQH3Gkv29rbWcKjvxCo4FhPjtVaHoFJ2b/smXh+URNz1B66wEq2XFZ+WkAABAqbgchy8vDx7Dz2YXjTDqQB9HUd0taT3lvJ0Pq069VfDrqnW3yvND83v62gJYV+w+7+CzBEQgOBm86y1xm0Ej/FfkihJUs3v6VEzsyaGeYN1mA8cL8eJXu5l0vJT9+DjpUENRyX00j06lLitKfUcG0oyk9ohKWwigtmYSRD9T2/7X6I3cE092MLMZ/xUhtELSkdWBjhfmYw2FBQ4vHlA3vwhEHo1GrrsURihAT2QQMUhSeCvdt+1JX2j1Qb/KebOqiRy8x15gP0DY7WY2nG7ow+edRCUvMeDVHYNLS8C9/TIa0ZebStOXBdMjGj1rQRUNYBKh+Pf8PLI+n3qJ5rOa+MeV9tX3yzc+JI0FqHy1+y08+DiWdH59ksEWB9fNTPrVyWJms/W9MR13dpQX6wHCyzqifkyc1l40pbow2k35d2mOnx2YVR+ne+cxOHOPgJIcQwiF9ZGUPca0VydscZdXOMBOjQNt9Mfr32/umtO7ViYLxJFer3cy+N1SMjySofktMK9gAEdE361qIofiQw8wdULbKC/H9Lj/kfwuTK+FVLzY2j/1QMMDbUzrByBL39KkpEFom637djbBHGKX2HiwCl+4H/YL32wxT4+tGNGspDmAzLPBwIUHQwgLGAoZ3HV3v8o81atyVocNQU1xZ8f6iKnSI47Qp7O4zqJJzOcXf7qIJrMYiEednt7IGsxrTT6hKbZiTMiRpUMa5JcAiE1EABVFI9gGcvjehhrAvE99sBkk5GrPs9MBk7pUdgEA58pdpmy6FJpM+rlBkcFJ82asQoDGDxWvMhBVRR4bVVokLu9/QoMTwvcsBx8jqjuyiwG8xbQru+l1SkhADy+KKtIjIETzaz/l48WNE9sVAmoDBy3st6vIdMqUULG0EC/l3w+PrBjVxscRAGxKNRux/NjTGNK/DZEM9kiGsKXn5SIDupbv16FhJSiJ7/izalvS+2CsqmdEePGCr1nmccW2IfvFtt8nJtcyB+uGWp2TjssbvOM09XpbyvkhsxRjzfkMIRP9PGjr7EFNS1gCgItvuzGrjj2JIv3agMngvGw6+8T7xGsNSmU/Agd6gdR35H6lRbvRIHFRnhbH+Hqz96t+6tiFk69eUrpz0ubnWeQckY3gOmiObmZ/n8nzp6htfLTCw+PrpvaoX9wSAMwK1+w2dcO5V2RRwAjI4Jl8FJfkAZLjhqa2b3uGlhZDwa7pI3JfAArqZUQKVrRy5+KfcM96HOcShh0eX90M7PzmXFKe1ZyVcZeMElrbMjhx9MmhGz69J32+sX+5f6dqHiYAYFuycZ/pG06G/CLd2HjIIM67PTev9JkOhnih9d9z0+pZgrXfnEv/kkwAAKTS6Wmb1yut3nASHSTBcudQ4u1lHd2Vo62+tfPHIre5F+2ReEKl4ty9fKNfXto+f1iLCq4iAJFrhRbD5m+/9IqsCBgjGYzy4HjyKLl2IwNVX/L9lZ3cQFoy/d4H95MIIfTCdBdHuZNcsR3W+hI40tcEnJsvuBqbWKYRnoX1qGLt6D463ILtgkHM2xuH10wf2KKyhxkAmHhU6+S/fP+Nz4mk0xoxGbyScb5/+4vVcQPWYeju2uJ0Bz9oEYpQU85XAySVH4+zhGn+y3XyR2IS+NqCZoPshb3MRpEfbx0NmDmkddXC5gAA9sVrdR45f+vJh99JV80RZNC6E3cZc4onGbIWe2e4+4LUdEGQaShniZcwyFDDh5Vm+Ch1gQet1brnFsNpPPXn9a3jm2YPa1/dywoAwNqrRvvhszcfv/eZnB/KYWTwGDDEt/lntduQtVhYJSwItMAgssYQ7KXsVx+frET3pXTm+sWqaOnPMaH3z+xcMXVQ21olXaUAABaFq7UeOnP90VuhZE8g55LB8Go4pAyoa8BKjE519JVJAcCubCmYjGHCv90W90man2Y451qLPWk4NHdyVNpUSfz25FLgmlnDOzcsm08OACB1LVmr7aCpK3aeuR9KVgNzAxkkO6hfuwMAAFmzhszipP6uguuiz4arxAsAYFm8pf+q489iEZpeXJOetVY6/Rf1V6d8H+ZSLnNPoVsoyGgRrQ3yW5LtNS1J88UrT+9aPXt0r5Y1S+WzAAAAB6+qLXqPX7L1+K3XxDUo15HBoyyzBNCcLyCEAFSNUMmw5LsMV4nPDz1Usuzag7XpWWOltbVATdzzhIZ9mBUKMnhBU4OgyqOzJIz69PTmmT1r547p3apWaXfL1Mt0HYv4Nuo0ePJ/mw9fff4jhfS43EwGaxy1mWCGoWW8nkCbeSKEag41Eo0myXfoIANNldaMSWUwl8t8B7NCZUMGk8qEvw2+cHjbyjnj+ndoXNU7v23a9qpD4YoNOw6atHiZQ8WHoX9JFyNkkAH/itpNMNXWlDtF2j8axs29GxqJRr/ALZ1koF5pbS2w0RJvuT7AXQYtkcHLWslgS+oOiplz4fL1WvccMXVxQOCZm08/ZQyRkhsU+E36FyEDZfRsomP6rIUMNHWRMRWMRKMP4JXuNQN1MtC4ZIDQYcC7sXYX3jNviYzpW9YinoTTwe9+aXcBmiYLJt2LkIEK2rfXlqWSpYFGE1TBjBJGotHr8FmHnrNWWlsLnAO8K2yX4Bfzlsj8Iksxr4BOR6AjnA5KE+RIMuhXT4cJglJvyIYMRlQ1Eo2+gBDdZKBWaW0tECjCe82ABn8Pui2hsUEOgi7H4JfWfUnnImSghsml6Zhg9iODLi2NRKPhcIkmGegeGax2xFuu73CVaUuk7zBqbJD/2evI7E+xSsR7kJCBOvaZxms1QfU1bB3b2qjENGNRqetynWRAdzcBu5uV23+IYUtkuBtoapB+OlZ0Fa2dP5O+RchAHZ/hBg4xkaKzxqLStu2xiMHOfl2bYRVXcL723+bIrpKuRcggK0pNxSFlr6XR3H210QHHCDlUdANzuQ5ZRGKUFkJpv2TttHgF6VmEDDRgWT4cbmcNjGc96q8FjrjgM4vhLleS+3KM0nTMEt7a9iAdi5BBKpbISioBqMbcz6G9Ed8zHp3imO0nuON/uS71wHcg8IuZ1qMJMaXKkWNHhAzScFH1QK9rSe7hddq1MyKdfpVzD1q2okA89nLFe03HJqudn9afOjh+JP2KkEEaUhwzmUAsqulov5SrxDOmb41JqZOLcX01frbbw0O5LshuYZK00+y9tp/+EweRbkXIIAOjZRn3fIqg+JwA2QNu8r67zDAqpUZ7DuQmILlWXQUfBRuYF09k2fvylVoJR7yE9CpCBpm4mTEwkA18iBDq4xnOaXhbu6qRXZB1V8btqoAJPIWDTqjiE4FBzFu3Htp++uDYXkF6FSGDdHya5OicxgV+qdF6/pUtw8HPPrm5W6ixqXWt+CiH1Itkp3kq17ci5bgfJXyVt4a2KEwxpUuRxUNCBmlQXGwtdp3WSwQAIun/0r8N96zM2gYTOlk/MT69TpAfY512uWgnb+X6WrQk1+WXGy51tHV4RXvH96RPETJIfTGsLQ5Vt26sBgAgdVTymnnv6fWBncio2nbXjVCvihHi9SxT+ovX8FiwsIq2ZzgJCDBppfXlP1d8gXQpQgYIIfRnrpNZn0MDrU3anSsFkooq097wio4n2ch8UCT/c+PU7CJqIJtt/XA/iQ+vfv1xvUSj2A/lf7QXzda6KHCCeB4SMkAIIfRrmq31pD0NqKJLwxFaAAPUfHL/9aJGMY73m7LMpJzRnng5ZOMdwjjRubwe64pYruQ1VuBWW8+LLEctOxzyn9P660vrXqRDETJA6PsYC/upi4tSDU4pEELo08asj+yyKsgwVve9CpJpNuWfGatuQ6tI1S5qzw7fulDtI1HcZGklXpdJvjaHZmy0eqmSaLD2oIZRRX3JsWVCBihykpnr5OE28gE6h/TfOkJjBl7F73qKaj5FryubLjbWmLop62zdAuh3kD9zbPIfQQgh9MRXNpPXOwXPlJV0e8QwzcUm0ECHw0iyX54vpD/lejJIWiMW9Wspzrcg2x2Di77gR/Nw67OeksK7FQihpLmyam+NVb3hg2X519IbHYTPtrNOv8UZpSyXlw3hs2ApO72h3nH6hBOzrRzU1rnyOFF2m3SnXE8Gh4vLOtWDivto3YZ4ugqUWJmt40vsjmrgtT1d4KPS5muN1pPl82Az68HZvoRTLncysZ8eqfTN68omc3m9X1IR1EjkNPwuHcUmnetpYdJZd3zTfdRm0ptyOxk8qEXVrgzV6W9XPRxoKW2wTsey4O9dbcxlHS4oWWnCJEn9T0ar4ojlxaDoxDvJCCGksevFXxiSB6psU1teTVls6svzRsrnBSUhT98Dv3Q+9GVLBzuqyv+yGfU9kg8nnSmXk0HMaHGxMlCb2eJ0zIGuNuDZa+OdLItR8Q93DPUWmTbfqm6ft72stxqxloMnFQNrv/lnv6xT86tWvDs6vaYZVWHBG00zpYryAL5L9mJpXRkU6bbqggZ2Tnl3elHbvGDRYn22OzrhBWonkc6Uu8ngQkHzgtCQhVNQ4o15ja2AKlCjy+gF6wL2Bq4PWDihe70iEpDXmHpO0y547EhRy1/GrOh3m3sUAqC8WwydvSJgR+DWgGUz+jctaw6iEkP2hmkbnk8St+K/0tEX5jRzBrAs3aTH+AXrAnYFbg9YvWB01/olTQAKtF92g8YKaGItj3DSl3I1GUT2oeyoZndYp/94atHQFpUK2tuKwNLWo1zT/nMOvtZ+IumSe95LRq7sqF7QoEuNoq62JiC3zVu8XveJW4N1+15cds8rjE/fr5ubJvf0K1/Q3lYKprZOBSs17zdtVzDdy9EGyR+TrpSryeCwkwlVC8+tOdUm0Jl7txZNNu6xaIQ5jGSapK1ogsFXeiV1lPSk3EwG0R1BVPQ4plJUG0/rsf/JK38wZmVPkkBlxok2ymuFGXa1Tonnk46Um8ngriNlswbbK6vaIHrPPfO23mu8uv5hCmDG3IHqSWEXgw48/sS6O+lHuZgMFL0p0YhofKWgSwYobgjV+5+x6nqkFABeME/3p41kkeH6WYQXqka8kHMxGdxzhrJYx+u0yQCho/ZFHxinqr9IAUC0iw33LpW2+mugtYrx9SQbCbmXDKIHUJJVeEvBgAzQl9omS43SH7G/FABM/FmlverqbZhRQ5KbO74hvSjXksEhF1GeV5hLUZ8BGaCUuZLmUcan6XdiAACoxi7153KO1wywUoqucnIiIdeSwfc2lKwW9iGr3yBGj1/LUzjE6DTdRQoAAHKWo5p/7WSbDK9SE8RkUzHXksEueydJb/yHa/36MHs+rLrFHiNT9HNRWpDY12xfwtMpf0MLEr2UWk+6UC4lg7AWVB0xH1ej+/VgmCBxBIw0Lgek1qkDA6D2sRaxz6xtvEHVaT21jPSgXEoGRx0LjRQt5KMUDKcJCCG027xGmBHp+UHGTRJj2Qu5Zlv7jwHVaYd4FulAuZMMYgZBn2UifgL3siAD9KRw3hvGo2c/oGQSAACoyUFKSN4yhsOAB8XjSf/JnWTwsJjd/h18DQvrsyADFNVcutpo9Bz9cP/cXlZWAMDpnOhHr4KGspN3SjaMdJ/cSQYbTOt8Pirm68rDamzIACnmiLsZ0/09f+FE9MP98zl5bv7ydTaMjZRL8t7kHrVcSQZxPUVTk2/zF8yGHRkgdMa+rBHdvBYBF7kL+VfL8akB1OW2ZYdk0ntyIxm8LWN/An12bp5saGSAPni73DEaXYcCDr+hmJoGwAYPrZuTAwm5kgzO2/q8R9HePF6pyZoM0N/GZvtyFxmgmBpO+r5K4oljfcIFuZIM/iftGIdQZycerzZiTwYoeQQ1y0gmr7/wkIH+2SDYvi65azk3kkHyKGqWAqEA0TkeS1FtNIfE6yRdjeM1FQWYblr/V8NNn5fO3bBuEkt6Ti4kg5hmZnsQQo/MpvBZCt8JXFKftarzxxh0HQe4HPmjvL31d1TrokVrMkfIjWQQWdX+NkIowbsGr2vH3pzIAD1yLf3NGJRtge2o0Wc3X30N1E/LO5Oo6LmRDMJKuT1HCKFp5vxecFZiLrf0H7wKvDACZRfC58v9xLq5frb2jsj6kD3F3EgG7wsV/YgQQg+ly/kthTvXiJq/K9vdNHxlVxyNT9YF2SB9VGGPdAjxNcqNZPAhX7kfCCGkqFKV53uQ3VdwlRDb3PyiwSu7YxuMwnbq4/jwVvFYwgW5kQw+FyyTekPqPlEwz6WwWctZRFJH+WlDV/a0klilyW4JXYE11DTSZXIjGXz19E6NdKkoynsobGsMK2vJ3WWGHnVnlwnO6XZKY7cfghZfMY1aSHpMbiSDH15eaaZ2hnqm+UngegYvA5Jd9AqZmiFo/lExQLafcbV1SsSNx/CKUdmyeTCyUD2FgLVN6i3dQjpMbiSDcG/Pr2l/tm+g9Ulc3Qb20e8eoLUMimHiXYzJQKdEzEi23oyTDNA92ULhavvPz+IU6S+5kQwSahdI93FLsQ9ACACl/g+lvVtShwSpxpXxbepAQfmJ9L81PpGRexykPq6aQcaj6Ukz80tLm+U9N1a8ObNiWCTiRcM+KL36qqVKL23GyzuzHBklVEqWjoWye0LVNtzX6S7pLrmSDPpaP0n/8wm8SDUcpGROSp1Z2ciU/gX1v7M8kZl7lHqHSCUf5UfVUqp9l4HJ1NqMETEeiVgxqzBC6mqCLOpSLYem4meMheoXjROmtu8Ke5L7EXInGfwnzrxS9SxEq3Vf5b/SJACA0vsm85fM75WegIy3WVoWoaAhAzVjhrR3nAoNpcvMxDxqA1J5oXKWiBPB8EL9ha9WKpWyaXgQqa7TfLGeKEhtg10qfCedJVeSwXHxf5kf9kNytmSg9q7XOBJQtVkVMgihQQZKpVWhIfUazBTvptk96ErECY859MggS9lUH8zEOuljAWp71rJRNOkruZIMPlj3Vfp0DcLSpwlI4zQhYzygcZoAWUkE1JeybgIADWNWelfqGOb6S48qDZxxSMQI/zIaRuxZ1aVeNpXiq+zgKKpVSOa9tttkPRNJV8mVZKCoXVb5VNoP6mLGAiLSuICIlH4H9QVEtXSZTyjlfVZpQSLjQVASpr6kpmsBTDFAFqTCWJwlYsRduKW2gJjeNZXUpbzcCpk6BGXSzcALk2U811YxESYTt8NcSgYrTJ6ofC49ke6yI6MnlJ7ZDzj7X0pX+Q1eezQXVGrPWl3aFiUtPvBa23+tTLaSfpJLyeC1udqpocnuSbyQQeYjmy2wGnNyK+v7hkoGe6XfMJNBQsmGfJLB57IGeeMrgRBkoKhWSc1nNlTCd5TBFa545SU0NIgIwhqL5jYAt8hb1AH+ynsnT4n3pJfkVjI4JMkSX69dCZ5PsM8uillgTI28hrorvkWCnae6efK2vLfPrPFf0klyKxmklOid5ZlXEp4vAx/ng1tiVHnPcMNUeEq5xrhFhpryFG5CMZMaSSKZ5F4y2G7yMetDQx35veGvb13sIsM9fQ00gO8lCvusa7x9JB8ljesoDSA9JPeSQWKhoRoeii7UhNe9pZad8Mt849jcQF9qA+1wU2uUw1geyvm5gt0F0kFyMRnskmk01JuyCXwWwncUD0JvywcZpsqjC/nhFrnK9CP+EYxjidekf+RmMqjVTvNjO6m1PBbCYwEfUo+K5xumzq+LcY++E4t0xl3IpZJ2xAM5V5PBK+qslucWiLfwVwizzbyIXUvtNEylT5TfxyzxIPUYq7yYTuKFxOswd5PB+AJaI58upFbyVYa/wFP0wgkyw5z0Jjco8BOvREXpdjjFvS1tH0T6Ru4mg2TnWdqfXEP587Qi9xp4Criq6GL1xCC1/rNAA8y6PCDCeHHEKdtyH0jXyOVkcAV0LRntN/fjxwHlOnzlqXYJddzCDFLt93GvbqYU74KNQueIuseRnpHbycDfS+ezwW5eIXyU4QDw5kEXaajuBthXN3dJMPlcRraQriL9gpBB0TG6Hw6rbYZ5HfzZ9C2XPqxy4K9+b2w7GuZCGO7VzaTCvRGK38nZvfGeR15yMImQAXoB2ZlB8lRRh984sw8DABCZVes9a/tjfip4QTYVIYRQoqH52E+RncAqb7P0xkRbzmfBV5k0CCe9gpABWmKf/apWkFserEv/TgAAABIx8HWdYwC1EyEUVsLgxr4jsF76ojjpSkkBgBPn/WknnpVCOgUhA4SatKeRIKIz1S8SX/6txalsAA6xfFVxtNltdNsJvAxO96Nlh3CJilzqARIAAPjMaYrgcpF0CUIGCKFkqzW0kgS6OO/Clv9CaSoXiPm75zm5ueNCqRiojwan/HHS3XgEvQag0kiVwwHpVSa1w0iPIGSAEELBQHOvIHKAqB6ucAFX0mzYPpa/Ov4sBAAgNUDn5GnUIjyClkM6WN9M/6edeBY5r0zIIBVLHWivu98oZTY7AUv+0aLUgcEy/qr4tWLqVMTLANUfIB6KpwNOEKWRAdsVnbueZIpAyCADLVrST5a0UO51CUsBvPgeGNxwlHIfQfOGE+ZN/+CQo+iUynjUXlbJU+ZJ65MpAiGDDHuwZ/R2/tAUWuGYK/SVAoB4KW8VPJsxgJZONsQGuJu36HMcchIaSwEAJIwcQb77p/7/lzqyxeRcEiGDjL+ewANmSU8Xlw7mft5mo5jfgYFitXn6yMDNIO09rJrlQRxyYspJAUDGZBFC4QMHEELoiH3R+6QrEGSSwSprprPXpE2uNku4Lh08AQDl29x46G3tIG1CfcsgmyBxODUyHoOc8PwSABMmw58FIsomDMUMhD7/SE8gUCKD9izi70RPNvPcy+19m2wGYBfLbyVPuUkAAGQjDLQRdlmVfoZBzBtbCciG0n/+jhhA2uRxcdtA0g8IVMjAeSGb9KHdRBXOcCpBNZ4HBgghFDNWJAEAe0PdOntfRb4WwxzmkblI3I3201FuYgCg7GqEkm5AoEIGL9gOoh/4QbXLHEowDuwEOFj4qIwIAM4ZajMkTZPUecddzAUJNKP9cLvUtRTTt6QXEKiSwXrzJLYybtSFekyZJCks5HZQ0MHAI0GTYWS4ACt7KSvkUuiV/ikh7FnwhaCgwMCDQUGXg1+G63/IcMdbvpT7sYCdAGFP7wUFHQsMDAq6GvxeRxjDgDSfRWk1chqBQJUMutfjIOViVWhKcy8i7OzqkU2LO4AKxM6lWo9bfymS16p+bg7w4MiK0W0ruluAOqw8qnaesPbkW/11jISZsor3OIwtQvYvHNigqKlavUzyVugwYf2FrEdNn5qkPyJaSroBgQoZFJ3CSc4pH6p1dnSQcHlW87wATlW6z1h76Orz0IiIZJQQEbEi5NLeVVM6+tgA5dl+8T2eXtJRp2d3yAtAuVZqP2bJ5iNXn777FRGBUHJExI93jy8d3LhwRMtyDgBm5bsvuhqrn7Z4WkPUj9Ve7YuAfj6mIPGo03d2wKCrz95HRMQhFBER9u7eqR3LxrYpZwPg3nzaaeVhQmwRSSZjPCP9gECJDH5Tx7gJUhwpB41v6DDYRQ3llFfXZVejtD4SfnZe2/xg23rtZ8yVDNvau4RIVLTNtG3rde/h/bu/Y3zTAiAtP+xAlB4aQ7HL1XYNw6hPX/7X0RXs6o/b/VxHwl/nl3QtKZZUHn8xfS44II0LxBJwaHGd9AMCJTI4C9xjWpyqArU1B9V9ObMkuPfZ/Z2GkPcbO9qLqizDxgfJF8aXpawaTT9Nv3eHHRpf3VRcedY94Z2UosfKPAPpZ/tqfkXKtvWKJ7RSRB4bVY6y734oFiG0HwAAZGDWZOUL0gkIVMlgpgcOaZfrQaXj6pYZv6s65Pe/Rd/Ek872cxA3P4Vh+q64NtiRKjvxCvO10ZiTQz3BY+JjwRvkYxdRpfP0iGNjZcg3NIhR3T6vriexGRr8BkBKicpNvZJIegBBFjJo3BGPvFvNqdK7le0zapajtP0Fpu/YxAP1KI+1HL0bv83MB+UWf2Kd/tmUwlB85R+hm+RBA6hyIluFvR9sYdblCouxy4+l3mACDgMORBDrJ9BIBo7Ygos86ijJvyw9+FbUdFvb6eyOw70eYuK2mgMd3OwodZ70imNl7g6ysBwk+ED6VlOq9F6dA6NnXSQeq1kva6yuIC64LoEYP4FGMngPGBeR3g8zt50UhhBS7HC1m8V+Je7LcLNi59n2p/pQaQcOj/8/K4uKurwSulkedRQX2ay1u/4cLPHelcRF/rtBpp6HiPUTaCKD44A1ePDvOU4mfV68qS4ayC2W8ocW0P4Xi3Qv/KAatpvVUvZ6SXoJftj/dW+Z+3KNRJqywsZ1E+cFldBOVC1yyzKBBjKY745ZblxAUallOe7Xpp3Mn/cS0zSxU2Vlz+KsTMr2AjZrBXdH+jTcQt77bpavP9aSTcZyP/KtclgORBDkNDLo1hi34KQ+lD+OaWlkW/E8ZinuFbZcnoS5Nv/GSSq/F7xx/qwtBeXWq/b8w1YlH2ASnzhF4hdFugCBGhmUH4O79zS2OoVJ1DrJECZeiatMmnzhQVFPytid0EP73Ohuaj1YaYNzkWgYxnsQb7uV+Ej6AIEKGaTIt+AVG1PZFd8W/UnzbrSHs8ndxLP5GfvG9afm6KOFfv9XBLznpg1LhkvWYRX+tbzLc9IJCJTJ4C3cwSo1ubkbzjfObesJNJ9MaGN9njddbZKM10sbKa4OcqQqrQhDaIrsFGbZ/5q4kbEBgTIZnAa8c8dRtk+wyrsg20jruZSWdsE8KuuQbKKeminpdHcrcZ3h4qPYJcfU8PxDugFBJhlssMbbd6U3MRdzswWt0B/Tbfj1Hz4p3qe3loo9UF+6iQe5USW6kW5AkEkG00tiHXp64A9K3qoWjZWA0+KTPKvrP7n+zvUklenMi9wQUxIDkSCTDHo3wilzblH8rq7fLQ5n+0x8wWm866ttA7011bo8kfwIXuJOXJMJMsigfl+c41nHzTwUdEzFbB9ZWoh/o/5mcVpPLZXgvpInyXF515KOQJBOBl4z6T2HEAIAUL3JXf1TgIt6n4TURGrPIUj7QuknSH8+SwG+iq5lU8QYux1Zi60t59RfVLJT+kJrKRCaWFZPLbXZMQ5D5TJ/UMLiAsQTkSDdkGw20SeDrNan9tmvh8bEoEkmZEhMM1ltWSBUYWw2RTwg/4eY5aycv9KzukqBnukrSBhTtWqunCZ+Q2+BXKhEkGE2+xAClPrKh7S3CaDMl0naNwCZXRcy3kFqFhZvvlub1aqmykoGoM2+EUJoinc2VenYBiFmOWv4A7IpBUJeM/TSULFm+/BUTmOdZpOeQJBqHH/hJEqngsz+DsqGBlk6rdp3GXgFj7RbrXIq1f4Pyk9qGqDvlmZTlSJzdJGBes5q/UXlRaujFAh1aamXhnqe9RJpNpXTTAZt25KeQJBqHN/gmmpfz7Qu5d4PaWME5Td66nfKEq/Adx0zd3UyQKpD8ozJQlajvZBdlEb5VoTo5wzKM+70gQ9AdqVAaKyPXhrqPPzCUTnQuBIyohrpCQSp5v4GHtIhA+V5hcqkWsW8TkKstgUHVQpR6f4q3VDjIP0efNBZkwQ4on2pI2vOqvyTlZu0rRmgOYX00lCHIAlH5bRMwUqTnkCQahwP4Q3KXDHQRQagbF6apwl34aMOq1WiFe0jA43d8BRkc1WwwzqdZKCWs1pO9MlgWHW9NNQN+IqjcprJoF890hMIUo3jGoQqrxcgpRdMxhqh6mKhjgXE0KyXNmqyWo0mq6sbbrLIpiplJ9EjA9AyR6FJBi076aWh3sNdHJXTTAZNe5CeQJBqHHdTyQAT3JZpt1r1ZW+NZKB5h79vdr5//r66yEDrgjtDP4NE2016aShFnhU4KqexlZPtNpCeQJBqHE/gJUYy6NuQl5K6L8nmgduUEHeLn5X+0k9L9eXPEfoa9ZX0BIJ0MsB54jjI9BsfBivJrqsryk0SQGGtOumppa7JeOO6AXVJRyBII4PQrK4BXOAzjoeCNu2e7SPn5Z9519cV0w/6aqo6A3kS/El2hXQEggwyuIZT5hFL/MFzrkhpnB1uWjuZZ3VFeWY6RSd8uC5okKDrUp4Ct7QlewkEGWQQDXijaTWri/vgy79CdEYbnxxH86stRRPvmPBHJzbM6NfIyxYALgvaVv29YvgQu8X8FekHBOlkgKzwrpB/s8Ps667oXILW7UgXJUv5VNbPYgBSAJCYpF1oHitoW/0r0o6Hkc9teQDpBgSZZJD9EWZmOCbGe0J+gjXNFc6Nonn86Sq5u5ktKENox+Qn1v2wnzV+YkuinhEok0HdAZjFrhXvwChtmoz2XWk7xIPjeVJVpJ/VVXTYSZrBBbJxQrfWVXl/zNfD3HFpnkx6AYESGXRvhlVoytEq+ahF2F7IfWUMwpAetqrAzxbcPQ/3ewihqIGUOJ0Net4TuiOdtWyANY71frNWJOQZgQoZTC6FUWTC5uJUs+vrxb3xLHeF1bc8x+T512XsNuIP3JMw06RRmrfRtYJpbEA5gk2LFSGCRgl64l70LjZh8eOpUSmkDxCokMF+Kbb3Q/SSvLIezxBCpxy8cHgvnHEunP3dgneaNm+Xipo1a9awBkfcG+cXi5ovyeg28VMkUgCAIoqnK1raglOHAAGvM/5eXzId01ThcSnLLaQHEKiRwRvAdJlnwgony9GfUv/+Uls28R9HeT96Ut1oXBb/A1RRStIXpwvAw2ZUMxV5T8qLAKSDEEIoOXhRIwtw6771s0AtplglL44jKGukv6zae9IBCNTJQGGJJaBx0iZ3M/+fmUsHK2zcA7kMohNW2bjvp/VkfXEmE4ja/kvZWlA28AMuKmhD+aj7YaSsMJPArvRPiddn1TIF77EXhJl/v20FjUK4svZqB4c1ZIpAkJUMUPXhGF5ZgV6SAaoXIH/vISp1gK3JJazNL5sQTe/ZXaIMKqDmKRBCievzi5uf4z6dT9xbHUof0SDnY0VQWaiMPTvKCyxarPsgRKtdKitqeYtD+r9L8pj4RxLrJ9BEBiOrcpZ0y0fU5U2Wb590EJVcF81C3Pd5biZDaA+9/5mkcYHEPP3i9OSDtakic95yGxSMdZW0vajlx6z3Hn5Y18ICvEadjeO92VKOVIKaO1n6PL0YZWfpT84pEmghgxNSjjtWP/uIamt2DHrWR2458Dazd3TS2Q4y+zFf6D4eu7ORONUnUFrwpXLWo/JCxaVvWA50HswoCkWnM1wKSLgw1hvkTdZ84b3lLrUzsR56k/Gw6+f/KkOh+RHE8gm0kUG0yWFOL6o1tnn3aP01amUpyD/6Ft09+fizfR2oajvo+g6lXOppKW02KXWO0ChK/ccBjuA59ARTqgvb29MFCoxlt6z6eUMbS8p3wUu+2y58aWlw7X+awfjg7bKaYouuV8iVKQQ6yADVGcRlhlBWNlb3VOD5TG+wbbX6SXaEkHBnYUO5qOoy2u/jF5PdofyKHyjJHoCixmt4UaYEz6shERXvvekxveW9f3dXdioI8sbzbHzYL7bHnejrCMUm3eO7271dXFUkqzY1KPv5f/LzTd3cwKnv8Thi9AS6yWCBB3vDHyWqS+OWoQ8bOzmDvMqwDZc1DqGT359b07esFDz67PlBN+ffqypB3vGpeY8QS0y0Dk7+nJ7RyBokxdrN2HntkzZCSnh7ccuEZgVF4NJqwdU4hF6XsT3BQbPJV0YVgHzDLiTx3II/Dw73psCj1cx99zTHYEp8e27dAF852DRbGkz2DwiyJ4OnrG8Nu1/cehvdafiLHSOrWwOYlajdadjMJQEBewJ3BgQsnDa4TY2iMgDHBhP303cPiD/cQmbRLSjdvO+BTPegPuXlgZntipsASPL7Nu4ybPqCdQEBgYF7AgJWL5gyuGNDnzwUgHm5bguOf8hYiuhJTeLmb/xgWimw73E8ke9W/H1uYadiUgDrUvU6DZuxMCBge2BgQMDKBeN6Na9SQAxgX9d/Rwg5g0BAjwxQaXYxw5JmS+swPAvw48a26YNaVS/mbmsrBpmtrUfJWh2Gzt5zL5KJkJtD7UT1tinPTfqF0+Kjb7f2Lfbv1aKUQ0F7W1sAsa2tU8FStVr3Gbf88P2f6k9vNK39g6OC3y6uQtn1vyTAKznp/YUNU/q3ql7cw9bWFMDW1qWgT+OuIxcduB9J7JyACRkscWdjr699zZYJvxwVOssLii34xEVEt8q0HntYMO9VzsX9tLgs5B0ZTIyNwEjIIExykXnqrXIfwe8k/rOlhshpGMeuFWO5it6DkS0kSzGw3cvpRcF7CdnbJzAKMkCNezBNGz+AGp8obHFTgrqYmbQ7wjnXvRK6w3/FAknrPziKfmuonbhJYDwxOQLDJ4M9Zj+ZJf3sY3NU6OlBAagc8BuDpOaN6D97yaXwYyzFjw9sInYY85oYHYGhk0GC23RGKYPzeL8RsqTxgfVETqOeY5H1U7adwdNh1eVbMFXi69wCVN39icTuCAyaDNBiBya+7vvlzaIFLOfjoXbiJkdw9aL/rBmdrU4aS/XH5auTcqq52GXmD2J5BIZMBpE2q+mnWyUaLdy+dcSq8lB4Ab7lN4UXU3/Lwzbl8J39/zLFwbRPCLE9AsMlAzTGk7a33HRqpVAlTAnqYmbRE6s//VV4yDTJmzI2x/EVIC6gONUgiFgfgcGSwReTjTTfrMNkuwQqX+qaYRReoV0qsOi/vagJGMdCijP1ofIpYn8EBkoGaHReWjFMFSNMTwpSOJxrhkr4Zcbq2pDNpvWwXsB8y4/yOUoOEBIYJhn8sp5PJ81Ik9NCFO0J1jVDJcy2Ybf0ed/d4yHWgtxvSVUid54SGCQZoPnWNN59E2QCDG/jd1bFumaohATXiSxThteW78Zblgf1oNULYoUEBkgGMXlHZZtirZj/9YI3Yx2kbc7zNITeJvvGNmnSKBiN+UjyaW/J0ChihwQGRwZoiyQ7Z7tDmK9R1NDjDjUQ5Zv9jS/xilLdOaTeJa/zE295UjY55TlADJHA4MhAUa2y7sOL98wm8FugH7Pyihof49GH4Qy3OyIeFsh/H3OJfvemmn0ipkhgYGSAnkr/p3PW7NaEV1+jR71MHMbze7VHjcbc0v+qZ7Ydd5kuF7E5SGyRwMDIAI231eEqm1ijMI/z25TDtaDk+lh+K3wObnOUkDyGGo47llncYBhKghMSGBgZxBToov3pyeb8hS+IXlZQ1DSI9333ShgunN5jXhP74YL9NmXIVIHAsMgAnaK0jlgviwP4KkfUbHvLoQKc7j1BPcQg5XHBfHdxl+x92XxPiT0SGBQZoH6O3zU/G5m/FU+l+D3N2nbabwGqqyjXBk+BG5puwV22v3VtrxGDJDAoMogu2ELzs/2df/FShsgJlvazhdlr3yfG9PZNnkANwe0cmdDJ7CqxSAJDIgN0VaTxTubr1B4+SpCy1sFhsUChEWLcB2GTFWhR7TvucUtLxzfEJAkMiQyQv9WHrF8mlmzIRwE+1pQJdx/wBHuMY5sQz7y3MZcvxteTeCMSGBQZxHlXynoV2WrTtzzkf8e5xAPBKvva5H9YpzeNTXF7Zn/L25HYJIEhkQF6YT5W/atY1xE8ZH9I3kTA4Gl+PnjvMkn2p6Zg3gs9BUeJURIYEhmgbZT6NYPr5N/x575cPEjAS78OUbdwi9wgaxuDV2KPfMT5iMCgyAB1d1C7HrVcb5qCAADU5WrOJXk4tUjb75AqBie+Ow3DXgV02b78V+Yq15HBd/NlGKQQEOAjg39eNVTe2SHZefGC8h9AJ5fkzqb7dfyO3axbFI3BXQWE0FuvPMHMyUBHBhOcYjFIISDARgbosdxf+eMSdwQo9UWU+k5CCNJeTQgA0r6BDBOFdFPV8PZK5wL5pbT3cPrzGWIze2TGt5lZpT8BasVReSJrnpsld3BXASGEUFQD+X61MQ1SKZKqFAAAnRn8NtuKQQoBAT4yQNupQKVP9fqgzH6YZoWpnUqp1yK1jyrfqXNBV/nFzPGuqtiMzgxZpSp3aNXiZPlXBR8spyPMVUhD0lBqtgKpjiq0/gtIRaSmDHr74pBCQICPDNAwCyVvPbsAtX6WboCg8goHUH2RpX+XlQu6yc9n7T2qf6WVTuktmDYkUJoyq+aRkVOWLON8fRIR3ipkYq2kc5yqQlUyUpasPtvXkMEdeItBCgEBRjJIqFokwwPmC9yg0ZOy9AbV75Sg6JHOBdmSgdq7XuNIQFWOJjLoZvcGIaxVUMY528ph2ZGBskzdGeRfjEMKAQE+MkDfXFsqMt5WoSqjc609CTKNUtfgdYL8nPJKmIpYyEIGoGWaAFlJBDSv/y0Wn0cZ0w48VVDBi8Luj7RNEzRwmu4MhlXDIYWAACMZoGuymWl/nYQYpX6asVYFSitXqktYupe11lK7lFfc0o1YwwKi8u+gvoColi7zCfUcT4tXpJcKVxXU8Lu2xdGsC4hqs52MhRDdGRySxWCQQkCAkwzQWupQ6h8nsNrZUfF8tiWiOxRWeea5dW/6KVkisa9oESZRP+AyMUwCQyMDNND8SRoZROHrSbflgxDPZKDyyEe36gm8kwFCS8W9EvBIyvcfMUwCgyODhFoFwhFC6DrgC13+xrF5spBVDPMsI8xRwJOW1fGEUa/fnxgmgcGRAQovWDMBIfQRsIX5iinpGyNkDUOLFA0XKKsQj0JYYqcMrUEMk8DwyAA9sRiAEErCd1i3vfNnISv4toB3mGCZ/ahmjeMayjmFiWESGCAZoMPUUoSQrz+mDP+TCnrV6B0nn18CZhffXbyKu5SN1sQwCQyRDNB88VGEhlfFk99l8TIhqydsvASEEJpHjeS8InKQbBASGCYZoEHy2+iEFMsi3GfHTkLWbpmg8RJSsde0Fdc1kRPwj1gmgUGSQXJjx8+x8r0YckuuVlLAxcOEgdQiPaj0mn3F71zJgERCJDBMMkBR3t6/OjXHkNtMMwHvCflaxeqwXnT62tPjOScBRyGeWCaBYZIB+pzP95AslHNmN8VrhKvZddeiL/Sk1J9VbDn5EG43JYZJYKhkgN44Nio0gmtefwo0UwhVL8VyafM/etNqXFvZDg7JVzkTwyQwWDJAt618zbm613V2Fcr7B/1sJpmn0KNaFWOpWexTzyV+BgQGTAbogsx8Gres9lLnhKrVxbwFbupZsevEPVlfvzbOhxgmgQGTAQoUmXJ6sf9wGCJQneLHi9tG6l2zpyzqst0T6NaUGCaBIZMB2gbeXHJq6yGQ+09wScsNhqDah3lKsFxzrTiWGCaBQZMBGgE92Ge0X6BJQuI0SZ33hqHbz94uwawS2qwnhklg2GSASsFUtvn8du4jSH1ulTJfpTAU5f5tYH6cRbIwIDezExg6GbyVUrMQQop7PRjv4HdzE8KpLnKQqN5bA9JuUl/xaoQQQjETGKS6At+JYRIYOBmgxWJqPkpuBNCEYTYX4JgAldnj4rTDwPQ7lxqdglByXThBP81Ke2KXBAZPBorG9tT8pgBAMbtHPd6rOf9VeVCL6h9hcArebdI6Fg0SUZ5JtJN09CN2SWDwZIB+uHoDBQDSBoySzZN/5LsiPweLKt0yRA1ftfOdDACi1bRTuM0jdklg+GSAjphRAAAA1xgk+iCfz3M14pfYuG5TGKaKX+UDAABbut7RH+EKsUsCwyeDMC9xKhdIKjNI1cwrgddKpGxxN5scbagqviBJ1dg4ms/vksURuyQweDL44J5q2AAA9IP9nYGLvNbhWAlJ/68Gq+En5qJUhUk/0EvQtwoxSwKDJ4PnkAmxN91ReVLxVnzW4KQv1eal4Sr4M6SNpUDanlYCRZ5ZxCwJDJ4MrlkrsQG1n2aq1SZv+Cv/iQpUs3uGrOCJShq7TSfBfbhPzJLACNYMjnpR6aYt8qQXXjDSwZ+vwift86GaBRu4hj9NdaTSVg0q0hlMTXUnVklgDGSAUnbmF6XxgWiLhp7//v6doKCzgYH7g4KCgh+F/kFotGMkP0X/uyy/uJ0xvEUTD9SipAAAVCANfZUbRKySwCjIAKGkAOfUWTCVN32P4F/wgeWjO1YtZAtZIHZwL9l1wqqjIbij+n0aY2U58r2xqPm1v7VIBKJ88dnry6ksL/oiIMBPBgjFLrWRAAUUzEWJDwKGNXAHEOWp1HrE/IDAc/fefoyIiEJIERER8e7V7TN71s4Z0rycM4DYs+nY7S9SMBU7uJM038JIY1J03PaKQMF4PemLgIAfMkAoeqY5QDMAX1Owrd53ycl32fnaxj8/NK97BXOwqj3uGOfQhImBtaHcjkRjU/WPhd4A+tAXAQGPZID+7fYBMPNospvRRkHyk82DfCSSSpMvcujJL/ydxM0uGpma/x0fWYqSVxvaZ57g+iIg4JEMIne0NJNUGdmW3S3t0SdGl6Zsux+OZZM4dks18Jj11bh0nKqvKZfihdcXAQGPZJB4yE9m1nIHt/n61zX1JOZdLjI9TBA80NqkfZBxzaP1qS8CAh7J4M14Z3GTAzhuAvy1qQoUWvCDfoIPC8tA8aU/jUu9etQXAQGfZPCoo7jArC/Y8n4xytFsiOazzXFqznpfl1em7PvfNDLlCqcvAgJByeBBE6rMXryXGseuLiDtoSGE8G3wUPr0c20tkXX308a2iCagvggIhCSDnwNEvqfwT1qTtnmaTVFbG4sbLwJIv6356/qGEvOOh43OB0dAfREQCEoG621cd/KzfpWwxNpd5Tj07cISADiHEFLcn+lDyVvtiTE+vQqoLwICIcngZ0vxOP6Ch3zrTA2LUxoWSABANiHuxEA3yDvghDG+BgXUFwGBoGRw1zU/v5H899h4f1QeFgBAfjlVfsZ949xME1BfBASCksEpixZ8X3oQWiHv48xhAQCAaMVXY9WpcPoiIBCWDPZJBiXzXo7oRta3M4cFAADHjVWlwumLgEBYMrgtnyZEQRI7ONcFUSYXyEYbqUYF05fLZ2K+BIKSwWfHvsKUJMQCAEBqIkuLnZLfOBUqmL4S6niTVUQCQcmgXa0EgYoSXmDo1UNrZgxtV6WQDQDAL6NUqID6KjiD2C+BgGRw0VS4aEJKeSWHPTkfboz61JO+CAj4J4PSEzWkAQDImhbSfoH0h5SfzXha5Vc1tOxo9Ppkpq9MNaV9o/7/OV5fBMZDBsHUOy1pQNPXqjYMys9CuvGrWrkKTphEGrk6Geor87/0f0BJkZDz9UVgRGQwuhLSbtyQYboAamSg+kcmGYC2noEQQijRfqORq5O1vjSQQW7QF4ERkUH1YTqNO9VYQemjChloGBmkf6Fx2IvqDjBydbLSV5p2QIU0VaZVOVZfBEZEBvkXI51zYHXjVp4eAyh9ozJlyHgHqqNXYyNXJ1N9ZSWDjN6vurKQQ/VFYERkYL1RRxqlXg+gMrrNOk3IWEjUNQdG/pWMXJ0s9KWZDEBtZJBD9UVgRGRQbKZu4wbVAa2a5YLKEBllTwYd2hi5OtnoK/170KignK0vAiMig0a9aBo3qJKB+m6C2laZNuOu5G/k6mSoL+X/sqiPBnkavb4IjIgMludL0WXcWlfH1f0M6O2b/5SeM3J1MtSXsp9BVjLIBfoiMCIyCBNfFrAwa12SjVydRF8EOZYMUBc/4cqS6DXb6PVJ9EWQY8ngi8UJwcqyyMP4j+ERfRHkWDJA8x3fCFSUq7ITOUChRF8EOZYMEut4RwlSkjeOg3KCQom+CHIsGaCo4pWEiCzwqkD9nLEaRvRFkGPJAL0vXPQD7+W47VAjKoeolOiLIMeSAQr3dT7LczE2mrfNOYthRF8EOZYM0L/O1Eg+be9Xa9GknDTmJfoiyLFkgNAu62K8Xeml2OrifjmHqZXoiyDHkgH62Apa8LNndquSeHBkjtMr0RdBjiUDhM4Xl/Z6gT3/m02pWg9ypGaJvghyLBmgpC3FRG1u4cw85VRNqJpjPWeIvghyLBkglHLQB7xX/saUdegsd6pRjp78En0R5FgyQAgFD7A26bD3L+d8f25oJHYd/zbH65foiyDHkgFC/7b6mZg23/yFQ6avVtQSW3Y4kpgrNEz0RZBjyQAh9GdXG0soOvjgNxZp32/vkQ8ce53ITT4zRF8EOZYMEEJJN2bXMgG3VvOCwugmUXw4NrWxA1j4/fdIkev0TPRFkGPJACGEYq4t7eQJYO3bc8He65+0D2Lj317ZMbNTWTmIvXutvZeUa3VN9EWQY8kAIYRQxNUN/k0KSgBEecrVa9dv3PzFAQEbAgP3BQQELJjj36d17dJOAGBSrNXEbXf/EX0TfRHkXDJIRcrXWweXT+jfrr5Pofy2ttYAlK2tbcEivg07Dpq8+uj970TRRF8EuYQMCAgICBkQEBAQMiAgICBkQEBAQMiAgIAgJ+L/1H1ywOH3ExQAAAAASUVORK5CYII=>>

@@ -1,380 +0,0 @@--- | Module implementing GIF decoding.
-module Codec.Picture.Gif ( decodeGif
-                         , decodeGifImages
-                         ) where
-
-import Control.Applicative( pure, (<$>), (<*>) )
-import Control.Monad( replicateM )
-import Control.Monad.ST( runST )
-import Control.Monad.Trans.Class( lift )
-
-import Data.Bits( (.&.), unsafeShiftR, testBit )
-import Data.Word( Word8, Word16 )
-
-import qualified Data.ByteString as B
-import qualified Data.Vector.Storable as V
-import qualified Data.Vector.Storable.Mutable as M
-
-import Data.Binary( Binary(..) )
-import Data.Binary.Get( Get
-                      , getWord8
-                      , getWord16le
-                      , getByteString
-                      )
-
-import Codec.Picture.InternalHelper
-import Codec.Picture.Types
-import Codec.Picture.Gif.LZW
-import Codec.Picture.BitWriter
-
-{-
-   <GIF Data Stream> ::=     Header <Logical Screen> <Data>* Trailer
-
-   <Logical Screen> ::=      Logical Screen Descriptor [Global Color Table]
-
-   <Data> ::=                <Graphic Block>  |
-                             <Special-Purpose Block>
-
-   <Graphic Block> ::=       [Graphic Control Extension] <Graphic-Rendering Block>
-
-   <Graphic-Rendering Block> ::=  <Table-Based Image>  |
-                                  Plain Text Extension
-
-   <Table-Based Image> ::=   Image Descriptor [Local Color Table] Image Data
-
-   <Special-Purpose Block> ::=    Application Extension  |
-                                  Comment Extension
- -}
-
---------------------------------------------------
-----            GifVersion
---------------------------------------------------
-data GifVersion = GIF87a | GIF89a
-
-gif87aSignature, gif89aSignature :: B.ByteString
-gif87aSignature = B.pack $ map (fromIntegral . fromEnum) "GIF87a"
-gif89aSignature = B.pack $ map (fromIntegral . fromEnum) "GIF89a"
-
-instance Binary GifVersion where
-    put GIF87a = put gif87aSignature
-    put GIF89a = put gif89aSignature
-
-    get = do
-        sig <- getByteString (B.length gif87aSignature)
-        case (sig == gif87aSignature, sig == gif89aSignature) of
-            (True, _)  -> pure GIF87a
-            (_ , True) -> pure GIF89a
-            _          -> fail $ "Invalid Gif signature : " ++ (toEnum . fromEnum <$> B.unpack sig)
-
-
---------------------------------------------------
-----         LogicalScreenDescriptor
---------------------------------------------------
--- | Section 18 of spec-gif89a
-data LogicalScreenDescriptor = LogicalScreenDescriptor
-  { -- | Stored on 16 bits
-    screenWidth           :: !Word16
-    -- | Stored on 16 bits
-  , screenHeight          :: !Word16
-    -- | Stored on 8 bits
-  , backgroundIndex       :: !Word8
-
-  -- | Stored on 1 bit
-  , hasGlobalMap          :: !Bool
-  -- | Stored on 3 bits
-  , colorResolution       :: !Word8
-  -- | Stored on 1 bit
-  , isColorTableSorted    :: !Bool
-  -- | Stored on 3 bits
-  , colorTableSize        :: !Word8
-  }
-
-instance Binary LogicalScreenDescriptor where
-    put _ = undefined
-    get = do
-        w <- getWord16le
-        h <- getWord16le
-        packedField  <- getWord8
-        backgroundColorIndex  <- getWord8
-        _aspectRatio  <- getWord8
-        return LogicalScreenDescriptor
-            { screenWidth           = w
-            , screenHeight          = h
-            , hasGlobalMap          = packedField `testBit` 7
-            , colorResolution       = (packedField `unsafeShiftR` 5) .&. 0x7 + 1
-            , isColorTableSorted    = packedField `testBit` 3
-            , colorTableSize        = (packedField .&. 0x7) + 1
-            , backgroundIndex       = backgroundColorIndex
-            }
-
-
---------------------------------------------------
-----            ImageDescriptor
---------------------------------------------------
--- | Section 20 of spec-gif89a
-data ImageDescriptor = ImageDescriptor
-  { gDescPixelsFromLeft         :: !Word16
-  , gDescPixelsFromTop          :: !Word16
-  , gDescImageWidth             :: !Word16
-  , gDescImageHeight            :: !Word16
-  , gDescHasLocalMap            :: !Bool
-  , gDescIsInterlaced           :: !Bool
-  , gDescIsImgDescriptorSorted  :: !Bool
-  , gDescLocalColorTableSize    :: !Word8
-  }
-
-imageSeparator, extensionIntroducer, gifTrailer :: Word8
-imageSeparator      = 0x2C
-extensionIntroducer = 0x21
-gifTrailer          = 0x3B
-
-graphicControlLabel :: Word8
-graphicControlLabel = 0xF9
-
---commentLabel, graphicControlLabel, applicationLabel
---
-{-commentLabel        = 0xFE-}
-{-plainTextLabel      = 0x01-}
-{-applicationLabel    = 0xFF-}
-
-parseDataBlocks :: Get B.ByteString
-parseDataBlocks = B.concat <$> (getWord8 >>= aux)
- where aux    0 = pure []
-       aux size = (:) <$> getByteString (fromIntegral size) <*> (getWord8 >>= aux)
-
-data GraphicControlExtension = GraphicControlExtension
-    { gceDisposalMethod        :: !Word8 -- ^ Stored on 3 bits
-    , gceUserInputFlag         :: !Bool
-    , gceTransparentFlag       :: !Bool
-    , gceDelay                 :: !Word16
-    , gceTransparentColorIndex :: !Word8
-    }
-
-instance Binary GraphicControlExtension where
-    put _ = undefined
-    get = do
-        -- due to missing lookahead
-        {-_extensionLabel  <- getWord8-}
-        _size            <- getWord8
-        packedFields     <- getWord8
-        delay            <- getWord16le
-        idx              <- getWord8
-        _blockTerminator <- getWord8
-        return GraphicControlExtension
-            { gceDisposalMethod        = (packedFields `unsafeShiftR` 2) .&. 0x07
-            , gceUserInputFlag         = packedFields `testBit` 1
-            , gceTransparentFlag       = packedFields `testBit` 0
-            , gceDelay                 = delay
-            , gceTransparentColorIndex = idx
-            }
-
-data GifImage = GifImage
-    { imgDescriptor   :: !ImageDescriptor
-    , imgLocalPalette :: !(Maybe Palette)
-    , imgLzwRootSize  :: !Word8
-    , imgData         :: B.ByteString
-    }
-
-instance Binary GifImage where
-    put _ = undefined
-    get = do
-        desc <- get
-        let hasLocalColorTable = gDescHasLocalMap desc
-        palette <- if hasLocalColorTable
-           then Just <$> getPalette (gDescLocalColorTableSize desc)
-           else pure Nothing
-
-        GifImage desc palette <$> getWord8 <*> parseDataBlocks
-
-data Block = BlockImage GifImage
-           | BlockGraphicControl GraphicControlExtension
-
-parseGifBlocks :: Get [Block]
-parseGifBlocks = getWord8 >>= blockParse
-  where blockParse v
-          | v == gifTrailer = pure []
-          | v == imageSeparator = (:) <$> (BlockImage <$> get) <*> parseGifBlocks
-          | v == extensionIntroducer = do
-                extensionCode <- getWord8
-                if extensionCode /= graphicControlLabel
-                   then parseDataBlocks >> parseGifBlocks
-                   else (:) <$> (BlockGraphicControl <$> get) <*> parseGifBlocks
-
-        blockParse v = do
-            fail ("Unrecognized gif block " ++ show v)
-
-instance Binary ImageDescriptor where
-    put _ = undefined
-    get = do
-        -- due to missing lookahead
-        {-_imageSeparator <- getWord8-}
-        imgLeftPos <- getWord16le
-        imgTopPos  <- getWord16le
-        imgWidth   <- getWord16le
-        imgHeight  <- getWord16le
-        packedFields <- getWord8
-        let tableSize = packedFields .&. 0x7
-        return ImageDescriptor
-            { gDescPixelsFromLeft = imgLeftPos
-            , gDescPixelsFromTop  = imgTopPos
-            , gDescImageWidth     = imgWidth
-            , gDescImageHeight    = imgHeight
-            , gDescHasLocalMap    = packedFields `testBit` 7
-            , gDescIsInterlaced     = packedFields `testBit` 6
-            , gDescIsImgDescriptorSorted = packedFields `testBit` 5
-            , gDescLocalColorTableSize = if tableSize > 0 then tableSize + 1 else 0
-            }
-
-
---------------------------------------------------
-----            Palette
---------------------------------------------------
-type Palette = Image PixelRGB8
-
-getPalette :: Word8 -> Get Palette
-getPalette bitDepth = replicateM (size * 3) get >>= return . Image size 1 . V.fromList
-  where size = 2 ^ (fromIntegral bitDepth :: Int)
-
---------------------------------------------------
-----            GifImage
---------------------------------------------------
-data GifHeader = GifHeader
-  { gifVersion          :: GifVersion
-  , gifScreenDescriptor :: LogicalScreenDescriptor
-  , gifGlobalMap        :: !Palette
-  }
-
-instance Binary GifHeader where
-    put _ = undefined
-    get = do
-        version    <- get
-        screenDesc <- get
-        palette    <- getPalette $ colorTableSize screenDesc
-        return GifHeader
-            { gifVersion = version
-            , gifScreenDescriptor = screenDesc
-            , gifGlobalMap = palette
-            }
-
-data GifFile = GifFile
-    { gifHeader  :: !GifHeader
-    , gifImages  :: [(Maybe GraphicControlExtension, GifImage)]
-    }
-
-associateDescr :: [Block] -> [(Maybe GraphicControlExtension, GifImage)]
-associateDescr [] = []
-associateDescr [BlockGraphicControl _] = []
-associateDescr (BlockGraphicControl _ : rest@(BlockGraphicControl _ : _)) = associateDescr rest
-associateDescr (BlockImage img:xs) = (Nothing, img) : associateDescr xs
-associateDescr (BlockGraphicControl ctrl : BlockImage img : xs) =
-    (Just ctrl, img) : associateDescr xs
-
-instance Binary GifFile where
-    put _ = undefined
-    get = do
-        hdr <- get
-        blocks <- parseGifBlocks
-        return GifFile { gifHeader = hdr
-                       , gifImages = associateDescr blocks }
-
-substituteColors :: Palette -> Image Pixel8 -> Image PixelRGB8
-substituteColors palette = pixelMap swaper
-  where swaper n = pixelAt palette (fromIntegral n) 0
-
-decodeImage :: GifImage -> Image Pixel8
-decodeImage img = runST $ runBoolReader $ do
-    outputVector <- lift . M.new $ width * height
-    decodeLzw (imgData img) 12 lzwRoot outputVector
-    frozenData <- lift $ V.unsafeFreeze outputVector
-    return . deinterlaceGif $ Image
-      { imageWidth = width
-      , imageHeight = height
-      , imageData = frozenData
-      }
-  where lzwRoot = fromIntegral $ imgLzwRootSize img
-        width = fromIntegral $ gDescImageWidth descriptor
-        height = fromIntegral $ gDescImageHeight descriptor
-        isInterlaced = gDescIsInterlaced descriptor
-        descriptor = imgDescriptor img
-
-        deinterlaceGif | not isInterlaced = id
-                       | otherwise = deinterlaceGifImage
-
-deinterlaceGifImage :: Image Pixel8 -> Image Pixel8
-deinterlaceGifImage img@(Image { imageWidth = w, imageHeight = h }) = generateImage generator w h
-   where lineIndices = gifInterlacingIndices h
-         generator x y = pixelAt img x y'
-            where y' = lineIndices V.! y
-
-gifInterlacingIndices :: Int -> V.Vector Int
-gifInterlacingIndices height = V.accum (\_ v -> v) (V.replicate height 0) indices
-    where indices = flip zip [0..] $
-                concat [ [0,     8 .. height - 1]
-                       , [4, 4 + 8 .. height - 1]
-                       , [2, 2 + 4 .. height - 1]
-                       , [1, 1 + 2 .. height - 1]
-                       ]
-
-paletteOf :: Palette -> GifImage -> Palette
-paletteOf global GifImage { imgLocalPalette = Nothing } = global
-paletteOf      _ GifImage { imgLocalPalette = Just p  } = p
-
-decodeAllGifImages :: GifFile -> [Image PixelRGB8]
-decodeAllGifImages GifFile { gifImages = [] } = []
-decodeAllGifImages GifFile { gifHeader = GifHeader { gifGlobalMap = palette
-                                                   , gifScreenDescriptor = wholeDescriptor
-                                                   }
-                           , gifImages = (_, firstImage) : rest } = map paletteApplyer $
- scanl generator (paletteOf palette firstImage, decodeImage firstImage) rest
-    where globalWidth = fromIntegral $ screenWidth wholeDescriptor
-          globalHeight = fromIntegral $ screenHeight wholeDescriptor
-
-          {-background = backgroundIndex wholeDescriptor-}
-
-          paletteApplyer (pal, img) = substituteColors pal img
-
-          generator (_, img1) (controlExt, img2@(GifImage { imgDescriptor = descriptor })) =
-                        (paletteOf palette img2, generateImage pixeler globalWidth globalHeight)
-               where localWidth = fromIntegral $ gDescImageWidth descriptor
-                     localHeight = fromIntegral $ gDescImageHeight descriptor
-
-                     left = fromIntegral $ gDescPixelsFromLeft descriptor
-                     top = fromIntegral $ gDescPixelsFromTop descriptor
-
-                     isPixelInLocalImage x y =
-                         x >= left && x < left + localWidth && y >= top && y < top + localHeight
-
-                     decoded = decodeImage img2
-
-                     transparent :: Int
-                     transparent = case controlExt of
-                        Nothing  -> 300
-                        Just ext -> if gceTransparentFlag ext
-                            then fromIntegral $ gceTransparentColorIndex ext
-                            else 300
-
-                     pixeler x y
-                        | isPixelInLocalImage x y && fromIntegral val /= transparent = val
-                            where val = pixelAt decoded (x - left) (y - top)
-                     pixeler x y = pixelAt img1 x y
-
-decodeFirstGifImage :: GifFile -> Either String (Image PixelRGB8)
-decodeFirstGifImage
-        GifFile { gifHeader = GifHeader { gifGlobalMap = palette}
-                , gifImages = ((_, gif):_) } = Right . substituteColors palette $ decodeImage gif
-decodeFirstGifImage _ = Left "No image in gif file"
-
--- | Transform a raw gif image to an image, witout
--- modifying the pixels.
--- This function can output the following pixel types :
---
---  * PixelRGB8
---
-decodeGif :: B.ByteString -> Either String DynamicImage
-decodeGif img = ImageRGB8 <$> (decode img >>= decodeFirstGifImage)
-
--- | Transform a raw gif to a list of images, representing
--- all the images of an animation.
-decodeGifImages :: B.ByteString -> Either String [Image PixelRGB8]
-decodeGifImages img = decodeAllGifImages <$> decode img
-

@@ -1,189 +0,0 @@-module Codec.Picture.Gif.LZW( decodeLzw, decodeLzwTiff ) where
-
-import Data.Word( Word8 )
-import Control.Applicative( (<$>) )
-import Control.Monad( when )
-
-import Data.Bits( (.&.) )
-
-import Control.Monad.ST( ST )
-import Control.Monad.Trans.Class( MonadTrans, lift )
-
-import Foreign.Storable ( Storable )
-
-import qualified Data.ByteString as B
-import qualified Data.Vector.Storable.Mutable as M
-
-import Codec.Picture.BitWriter
-
-{-# INLINE (.!!!.) #-}
-(.!!!.) :: (Storable a) => M.STVector s a -> Int -> ST s a
-(.!!!.) = M.unsafeRead 
-        {-M.read-}
-
-{-# INLINE (..!!!..) #-}
-(..!!!..) :: (MonadTrans t, Storable a)
-          => M.STVector s a -> Int -> t (ST s) a
-(..!!!..) v idx = lift $ v .!!!. idx
-
-{-# INLINE (.<-.) #-}
-(.<-.) :: (Storable a) => M.STVector s a -> Int -> a -> ST s ()
-(.<-.) = M.unsafeWrite 
-         {-M.write-}
-
-{-# INLINE (..<-..) #-}
-(..<-..) :: (MonadTrans t, Storable a)
-         => M.STVector s a -> Int -> a -> t (ST s) ()
-(..<-..) v idx = lift . (v .<-. idx)
-
-
-duplicateData :: (Show a, MonadTrans t, Storable a)
-              => M.STVector s a -> M.STVector s a
-              -> Int -> Int -> Int -> t (ST s) ()
-duplicateData src dest sourceIndex size destIndex = lift $ aux sourceIndex destIndex
-  where endIndex = sourceIndex + size
-        aux i _ | i == endIndex  = return ()
-        aux i j = do
-          src .!!!. i >>= (dest .<-. j)
-          aux (i + 1) (j + 1)
-
-rangeSetter :: (Storable a, Num a)
-            => Int -> M.STVector s a
-            -> ST s (M.STVector s a)
-rangeSetter count vec = aux 0
-  where aux n | n == count = return vec
-        aux n = (vec .<-. n) (fromIntegral n) >> aux (n + 1)
-
-decodeLzw :: B.ByteString -> Int -> Int -> M.STVector s Word8
-          -> BoolReader s ()
-decodeLzw str maxBitKey initialKey outVec = do
-    setDecodedString str
-    lzw GifVariant maxBitKey initialKey 0 outVec
-
-isOldTiffLZW :: B.ByteString -> Bool
-isOldTiffLZW str = firstByte == 0 && secondByte == 1
-    where firstByte = str `B.index` 0
-          secondByte = (str `B.index` 1) .&. 1
-
-decodeLzwTiff :: B.ByteString -> M.STVector s Word8 -> Int
-              -> BoolReader s()
-decodeLzwTiff str outVec initialWriteIdx = do
-    setDecodedString str
-    let variant | isOldTiffLZW str = OldTiffVariant
-                | otherwise = TiffVariant
-    lzw variant 12 9 initialWriteIdx outVec
-
-data TiffVariant =
-      GifVariant
-    | TiffVariant
-    | OldTiffVariant
-    deriving Eq
-
--- | Gif image constraint from spec-gif89a, code size max : 12 bits.
-lzw :: TiffVariant -> Int -> Int -> Int -> M.STVector s Word8
-    -> BoolReader s ()
-lzw variant nMaxBitKeySize initialKeySize initialWriteIdx outVec = do
-    -- Allocate buffer of maximum size.
-    lzwData <- lift (M.replicate maxDataSize 0) >>= resetArray
-    lzwOffsetTable <- lift (M.replicate tableEntryCount 0) >>= resetArray
-    lzwSizeTable <- lift $ M.replicate tableEntryCount 0
-    lift $ lzwSizeTable `M.set` 1
-
-    let firstVal code = do
-            dataOffset <- lzwOffsetTable ..!!!.. code
-            lzwData ..!!!.. dataOffset
-
-        writeString at code = do
-            dataOffset <- lzwOffsetTable ..!!!.. code
-            dataSize   <- lzwSizeTable   ..!!!.. code
-
-            when (at + dataSize <= maxWrite) $
-                 duplicateData lzwData outVec dataOffset dataSize at
-
-            return dataSize
-
-        addString pos at code val = do
-            dataOffset <- lzwOffsetTable ..!!!.. code
-            dataSize   <- lzwSizeTable   ..!!!.. code
-
-            when (pos < tableEntryCount) $ do
-              (lzwOffsetTable ..<-.. pos) at
-              (lzwSizeTable ..<-.. pos) $ dataSize + 1
-
-            when (at + dataSize + 1 <= maxDataSize) $ do
-              duplicateData lzwData lzwData dataOffset dataSize at
-              (lzwData ..<-.. (at + dataSize)) val
-
-            return $ dataSize + 1
-
-        maxWrite = M.length outVec
-        loop outWriteIdx writeIdx dicWriteIdx codeSize oldCode code
-          | outWriteIdx >= maxWrite = return ()
-          | code == endOfInfo = return ()
-          | code == clearCode = do
-              toOutput <- getNextCode startCodeSize
-              if toOutput == endOfInfo then
-                return ()
-              else do
-                dataSize <- writeString outWriteIdx toOutput
-                getNextCode startCodeSize >>=
-                  loop (outWriteIdx + dataSize)
-                       firstFreeIndex firstFreeIndex startCodeSize toOutput
-
-          | otherwise =  do
-              (written, dicAdd) <-
-                   if code >= writeIdx then do
-                     c <- firstVal oldCode
-                     wroteSize <- writeString outWriteIdx oldCode
-                     (outVec ..<-.. (outWriteIdx + wroteSize)) c
-                     addedSize <- addString writeIdx dicWriteIdx oldCode c
-                     return (wroteSize + 1, addedSize)
-                   else do
-                     wroteSize <- writeString outWriteIdx code
-                     c <- firstVal code
-                     addedSize <- addString writeIdx dicWriteIdx oldCode c
-                     return (wroteSize, addedSize)
-
-              let new_code_size = updateCodeSize codeSize $ writeIdx + 1
-              getNextCode new_code_size >>=
-                loop (outWriteIdx + written)
-                     (writeIdx + 1)
-                     (dicWriteIdx + dicAdd)
-                     new_code_size
-                     code
-
-    getNextCode startCodeSize >>=
-        loop initialWriteIdx firstFreeIndex firstFreeIndex startCodeSize 0
-
-  where tableEntryCount =  2 ^ min 12 nMaxBitKeySize
-        maxDataSize = tableEntryCount `div` 2 * (1 + tableEntryCount) + 1
-
-        isNewTiff = variant == TiffVariant
-        (switchOffset,  isTiffVariant) = case variant of
-            GifVariant -> (0, False)
-            TiffVariant -> (1, True)
-            OldTiffVariant -> (0, True)
-
-        initialElementCount = 2 ^ initialKeySize :: Int
-        clearCode | isTiffVariant = 256
-                  | otherwise = initialElementCount
-
-        endOfInfo | isTiffVariant = 257
-                  | otherwise = clearCode + 1
-
-        startCodeSize 
-                  | isTiffVariant = initialKeySize
-                  | otherwise = initialKeySize + 1
-
-        firstFreeIndex = endOfInfo + 1
-
-        resetArray a = lift $ rangeSetter initialElementCount a
-
-        updateCodeSize codeSize writeIdx
-            | writeIdx == 2 ^ codeSize - switchOffset = min 12 $ codeSize + 1
-            | otherwise = codeSize
-
-        getNextCode s 
-            | isNewTiff = fromIntegral <$> getNextBitsMSBFirst s
-            | otherwise = fromIntegral <$> getNextBitsLSBFirst s
-

@@ -1,462 +0,0 @@--- | Module dedicated of Radiance file decompression (.hdr or .pic) file.
--- Radiance file format is used for High dynamic range imaging.
-module Codec.Picture.HDR( decodeHDR, encodeHDR, writeHDR ) where
-
-import Data.Bits( Bits, (.&.), (.|.), unsafeShiftL, unsafeShiftR )
-import Data.Char( ord, chr, isDigit )
-import Data.Word( Word8 )
-import Data.Monoid( (<>) )
-import Control.Applicative( pure, (<$>), (<*>) )
-import Control.Monad( when, foldM, foldM_, forM, forM_ )
-import Control.Monad.Trans.Class( lift )
-import Control.Monad.Trans.Error( ErrorT, throwError, runErrorT )
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Lazy as L
-import qualified Data.ByteString.Char8 as BC
-
-import Data.List( partition )
-import Data.Binary( Binary( .. ), encode )
-import Data.Binary.Get( Get, getByteString, getWord8 )
-import Data.Binary.Put( putByteString, putLazyByteString )
-
-import Control.Monad.ST( ST, runST )
-import Foreign.Storable ( Storable )
-import Control.Monad.Primitive ( PrimState, PrimMonad )
-import qualified Data.Vector.Storable as V
-import qualified Data.Vector.Storable.Mutable as M
-
-import Codec.Picture.InternalHelper
-import Codec.Picture.Types
-import Codec.Picture.VectorByteConversion
-
-{-# INLINE (.<<.) #-}
-(.<<.), (.>>.) :: (Bits a) => a -> Int -> a
-(.<<.) = unsafeShiftL
-(.>>.) = unsafeShiftR
-
-{-# INLINE (.<-.) #-}
-(.<-.) :: (PrimMonad m, Storable a)
-       => M.STVector (PrimState m) a -> Int -> a -> m ()
-(.<-.) = M.write 
-         {-M.unsafeWrite-}
-
-type HDRReader s a = ErrorT String (ST s) a
-
-data RGBE = RGBE !Word8 !Word8 !Word8 !Word8
-
-instance Binary RGBE where
-    put (RGBE r g b e) = put r >> put g >> put b >> put e
-    get = RGBE <$> get <*> get <*> get <*> get
-
-checkLineLength :: RGBE -> Int
-checkLineLength (RGBE _ _ a b) =
-    (fromIntegral a .<<. 8) .|. fromIntegral b
-
-isNewRunLengthMarker :: RGBE -> Bool
-isNewRunLengthMarker (RGBE 2 2 _ _) = True
-isNewRunLengthMarker _ = False
-
-data RadianceFormat =
-      FormatRGBE
-    | FormatXYZE
-
-radiance32bitRleRGBEFormat, radiance32bitRleXYZEFromat :: B.ByteString
-radiance32bitRleRGBEFormat = BC.pack "32-bit_rle_rgbe"
-radiance32bitRleXYZEFromat = BC.pack "32-bit_rle_xyze"
-
-instance Binary RadianceFormat where
-  put FormatRGBE = putByteString radiance32bitRleRGBEFormat
-  put FormatXYZE = putByteString radiance32bitRleXYZEFromat
-
-  get = getByteString (B.length radiance32bitRleRGBEFormat) >>= format
-    where format sig
-            | sig == radiance32bitRleRGBEFormat = pure FormatRGBE
-            | sig == radiance32bitRleXYZEFromat = pure FormatXYZE
-            | otherwise = fail "Unrecognized Radiance format"
-
-toRGBE :: PixelRGBF -> RGBE
-toRGBE (PixelRGBF r g b)
-    | d <= 1e-32 = RGBE 0 0 0 0
-    | otherwise = RGBE (fix r) (fix g) (fix b) (fromIntegral $ e + 128)
-  where d = maximum [r, g, b]
-        e = exponent d
-        coeff = significand d *  255.9999 / d
-        fix v = truncate $ v * coeff
-
-
-dropUntil :: Word8 -> Get ()
-dropUntil c = getWord8 >>= inner
-  where inner val | val == c = pure ()
-        inner _ = getWord8 >>= inner
-
-getUntil :: (Word8 -> Bool) -> B.ByteString -> Get B.ByteString
-getUntil f initialAcc = getWord8 >>= inner initialAcc
-  where inner acc c | f c = pure acc
-        inner acc c = getWord8 >>= inner (B.snoc acc c)
-
-data RadianceHeader = RadianceHeader
-  { radianceInfos :: [(B.ByteString, B.ByteString)]
-  , radianceFormat :: RadianceFormat
-  , radianceHeight :: !Int
-  , radianceWidth  :: !Int
-  , radianceData   :: L.ByteString
-  }
-
-radianceFileSignature :: B.ByteString
-radianceFileSignature = BC.pack "#?RADIANCE\n"
-
-unpackColor :: L.ByteString -> Int -> RGBE
-unpackColor str idx = RGBE (at 0) (at 1) (at 2) (at 3)
-  where at n = L.index str . fromIntegral $ idx + n
-
-storeColor :: M.STVector s Word8 -> Int -> RGBE -> ST s ()
-storeColor vec idx (RGBE r g b e) = do
-    (vec .<-. (idx + 0)) r
-    (vec .<-. (idx + 1)) g
-    (vec .<-. (idx + 2)) b
-    (vec .<-. (idx + 3)) e
-
-parsePair :: Char -> Get (B.ByteString, B.ByteString)
-parsePair firstChar = do
-    let eol c = c == fromIntegral (ord '\n')
-    line <- getUntil eol B.empty
-    case BC.split '=' line of
-      [] -> pure (BC.singleton firstChar, B.empty)
-      [val] -> pure (BC.singleton firstChar, val)
-      [key, val] -> pure (BC.singleton firstChar <> key, val)
-      (key : vals) -> pure (BC.singleton firstChar <> key, B.concat vals)
-
-decodeInfos :: Get [(B.ByteString, B.ByteString)]
-decodeInfos = do
-    char <- getChar8
-    case char of
-      -- comment
-      '#' -> dropUntil (fromIntegral $ ord '\n') >> decodeInfos
-      -- end of header, no more information
-      '\n' -> pure []
-      -- Classical parsing
-      c -> (:) <$> parsePair c <*> decodeInfos
-
-
--- | Decode an HDR (radiance) image, the resulting pixel
--- type can be :
---
---  * PixelRGBF
---
-decodeHDR :: B.ByteString -> Either String DynamicImage
-decodeHDR str = runST $ runErrorT $ do
-    case runGet decodeHeader $ L.fromChunks [str] of
-      Left err -> throwError err
-      Right rez ->
-          ImageRGBF <$> (decodeRadiancePicture rez >>= lift . unsafeFreezeImage)
-
-getChar8 :: Get Char
-getChar8 = chr . fromIntegral <$> getWord8
-
-isSign :: Char -> Bool
-isSign c = c == '+' || c == '-'
-
-isAxisLetter :: Char -> Bool
-isAxisLetter c = c == 'X' || c == 'Y'
-
-decodeNum :: Get Int
-decodeNum = do
-    sign <- getChar8
-    letter <- getChar8
-    space <- getChar8
-
-    when (not $ isSign sign && isAxisLetter letter && space == ' ')
-         (fail "Invalid radiance size declaration")
-
-    let numDec acc c | isDigit c =
-            getChar8 >>= numDec (acc * 10 + ord c - (ord '0'))
-        numDec acc _
-            | sign == '-' = pure $ negate acc
-            | otherwise = pure acc
-
-    getChar8 >>= numDec 0
-
-copyPrevColor :: M.STVector s Word8 -> Int -> ST s ()
-copyPrevColor scanLine idx = do
-    r <- scanLine `M.unsafeRead` (idx - 4)
-    g <- scanLine `M.unsafeRead` (idx - 3)
-    b <- scanLine `M.unsafeRead` (idx - 2)
-    e <- scanLine `M.unsafeRead` (idx - 1)
-
-    (scanLine `M.unsafeWrite` (idx + 0)) r
-    (scanLine `M.unsafeWrite` (idx + 1)) g
-    (scanLine `M.unsafeWrite` (idx + 2)) b
-    (scanLine `M.unsafeWrite` (idx + 3)) e
-
-oldStyleRLE :: L.ByteString -> Int -> M.STVector s Word8
-            -> HDRReader s Int
-oldStyleRLE inputData initialIdx scanLine = inner initialIdx 0 0
-  where maxOutput = M.length scanLine
-        maxInput = fromIntegral $ L.length inputData
-
-        inner readIdx writeIdx _
-            | readIdx >= maxInput || writeIdx >= maxOutput = pure readIdx
-        inner readIdx writeIdx shift = do
-          let color@(RGBE r g b e) = unpackColor inputData readIdx
-              isRun = r == 1 && g == 1 && b == 1
-
-          if not isRun
-            then do
-              lift $ storeColor scanLine writeIdx color
-              inner (readIdx + 4) (writeIdx + 4) 0
-         
-            else do
-              let count = fromIntegral e .<<. shift
-              lift $ forM_ [0 .. count] $ \i -> copyPrevColor scanLine (writeIdx + 4 * i)
-              inner (readIdx + 4) (writeIdx + 4 * count) (shift + 8)
-
-newStyleRLE :: L.ByteString -> Int -> M.STVector s Word8
-            -> HDRReader s Int
-newStyleRLE inputData initialIdx scanline = foldM inner initialIdx [0 .. 3]
-  where dataAt idx
-            | fromIntegral idx >= maxInput = throwError $ "Read index out of bound (" ++ show idx ++ ")"
-            | otherwise = pure $ L.index inputData (fromIntegral idx)
-
-        maxOutput = M.length scanline
-        maxInput = fromIntegral $ L.length inputData
-        stride = 4
-
-
-        strideSet count destIndex _ | endIndex > maxOutput + stride =
-          throwError $ "Out of bound HDR scanline " ++ show endIndex ++ " (max " ++ show maxOutput ++ ")"
-            where endIndex = destIndex + count * stride
-        strideSet count destIndex val = aux destIndex count
-            where aux i 0 =  pure i
-                  aux i c = do
-                    lift $ (scanline .<-. i) val
-                    aux (i + stride) (c - 1)
-
-
-        strideCopy _ count destIndex
-            | writeEndBound > maxOutput + stride = throwError "Out of bound HDR scanline"
-                where writeEndBound = destIndex + count * stride
-        strideCopy sourceIndex count destIndex = aux sourceIndex destIndex count
-          where aux _ j 0 = pure j
-                aux i j c = do
-                    val <- dataAt i
-                    lift $ (scanline .<-. j) val
-                    aux (i + 1) (j + stride) (c - 1)
-
-        inner readIdx writeIdx
-            | readIdx >= maxInput || writeIdx >= maxOutput = pure readIdx
-        inner readIdx writeIdx = do
-          code <- dataAt readIdx
-          if code > 128
-            then do
-              let repeatCount = fromIntegral code .&. 0x7F
-              newVal <- dataAt $ readIdx + 1
-              endIndex <- strideSet repeatCount writeIdx newVal
-              inner (readIdx + 2) endIndex 
-
-            else do
-              let iCode = fromIntegral code
-              endIndex <- strideCopy (readIdx + 1) iCode writeIdx
-              inner (readIdx + iCode + 1) endIndex
-
-instance Binary RadianceHeader where
-    get = decodeHeader
-    put hdr = do
-        putByteString radianceFileSignature
-        putByteString $ BC.pack "FORMAT="
-        put $ radianceFormat hdr
-        let sizeString =
-              BC.pack $ "\n\n-Y " ++ show (radianceHeight hdr)
-                        ++ " +X " ++ show (radianceWidth hdr) ++ "\n"
-        putByteString sizeString
-        putLazyByteString $ radianceData hdr
-
-
-decodeHeader :: Get RadianceHeader
-decodeHeader = do
-    sig <- getByteString $ B.length radianceFileSignature
-    when (sig /= radianceFileSignature)
-         (fail "Invalid radiance file signature")
-
-    infos <- decodeInfos
-    let formatKey = BC.pack "FORMAT"
-    case partition (\(k,_) -> k /= formatKey) infos of
-      (_, []) -> fail "No radiance format specified"
-      (info, [(_, formatString)]) ->
-        case runGet get $ L.fromChunks [formatString] of
-          Left err -> fail err
-          Right format -> do
-              (n1, n2, b) <- (,,) <$> decodeNum
-                                  <*> decodeNum
-                                  <*> getRemainingBytes
-              return . RadianceHeader info format n1 n2 $ L.fromChunks [b]
-
-      _ -> fail "Multiple radiance format specified"
-
-toFloat :: RGBE -> PixelRGBF
-toFloat (RGBE r g b e) = PixelRGBF rf gf bf
-  where f = encodeFloat 1 $ fromIntegral e - (128 + 8)
-        rf = (fromIntegral r + 0.0) * f
-        gf = (fromIntegral g + 0.0) * f
-        bf = (fromIntegral b + 0.0) * f
-
-encodeScanlineColor :: M.STVector s Word8
-                    -> M.STVector s Word8
-                    -> Int
-                    -> ST s Int
-encodeScanlineColor vec outVec outIdx = do
-    val <- vec `M.unsafeRead` 0
-    runLength 1 0 val 1 outIdx
-  where maxIndex = M.length vec
-
-        pushRun len val at = do
-            (outVec `M.unsafeWrite` at) $ fromIntegral $ len .|. 0x80
-            (outVec `M.unsafeWrite` (at + 1)) val
-            return $ at + 2
-
-        pushData start len at = do
-            (outVec `M.unsafeWrite` at) $ fromIntegral len
-            let first = start - len
-                end = start - 1
-                offset = at - first + 1
-            forM_ [first .. end] $ \i -> do
-                v <- vec `M.unsafeRead` i
-                (outVec `M.unsafeWrite` (offset + i)) v
-
-            return $ at + len + 1
-
-        -- End of scanline, empty the thing
-        runLength run cpy prev idx at | idx >= maxIndex =
-            case (run, cpy) of
-                (0, 0) -> pure at
-                (0, n) -> pushData idx n at
-                (n, 0) -> pushRun n prev at
-                (_, _) -> error "HDR - Run length algorithm is wrong"
-
-        -- full runlength, we must write the packet
-        runLength r@127   _ prev idx at = do
-            val <- vec `M.unsafeRead` idx
-            pushRun r prev at >>=
-                runLength 1 0 val (idx + 1)
-
-        -- full copy, we must write the packet
-        runLength   _ c@127    _ idx at = do
-            val <- vec `M.unsafeRead` idx
-            pushData idx c at >>=
-                runLength 1 0 val (idx + 1)
-
-        runLength n 0 prev idx at = do
-            val <- vec `M.unsafeRead` idx
-            case val == prev of
-               True -> runLength (n + 1) 0 prev (idx + 1) at
-               False | n < 4 -> runLength 0 (n + 1) val (idx + 1) at
-               False -> do
-                    pushRun n prev at >>=
-                        runLength 1 0 val (idx + 1)
-
-        runLength 0 n prev idx at = do
-            val <- vec `M.unsafeRead` idx
-            if val /= prev
-               then runLength 0 (n + 1) val (idx + 1) at
-               else do
-                pushData (idx - 1) (n - 1) at >>=
-                    runLength (2 :: Int) 0 val (idx + 1)
-
-        runLength _ _ _ _ _ =
-            error "HDR RLE inconsistent state"
-
--- | Write an High dynamic range image into a radiance
--- image file on disk.
-writeHDR :: FilePath -> Image PixelRGBF -> IO ()
-writeHDR filename img = L.writeFile filename $ encodeHDR img
-
--- | Encode an High dynamic range image into a radiance image
--- file format.
-encodeHDR :: Image PixelRGBF -> L.ByteString
-encodeHDR pic = encode $ runST $ do
-    let w = imageWidth pic
-        h = imageHeight pic
-
-    scanLineR <- M.new w :: ST s (M.STVector s Word8)
-    scanLineG <- M.new w
-    scanLineB <- M.new w
-    scanLineE <- M.new w
-
-    encoded <-
-        forM [0 .. h - 1] $ \line -> do
-            buff <- M.new $ w * 4 + w `div` 127 + 2
-            let columner col | col >= w = return ()
-                columner col = do
-                      let RGBE r g b e = toRGBE $ pixelAt pic col line
-                      (scanLineR `M.unsafeWrite` col) r
-                      (scanLineG `M.unsafeWrite` col) g
-                      (scanLineB `M.unsafeWrite` col) b
-                      (scanLineE `M.unsafeWrite` col) e
-
-                      columner (col + 1)
-
-            columner 0
-
-            (buff `M.unsafeWrite` 0) 2
-            (buff `M.unsafeWrite` 1) 2
-            (buff `M.unsafeWrite` 2) $ fromIntegral ((w .>>. 8) .&. 0xFF)
-            (buff `M.unsafeWrite` 3) $ fromIntegral (w .&. 0xFF)
-
-            i1 <- encodeScanlineColor scanLineR buff 4        
-            i2 <- encodeScanlineColor scanLineG buff i1
-            i3 <- encodeScanlineColor scanLineB buff i2
-            endIndex <- encodeScanlineColor scanLineE buff i3
-
-            (\v -> blitVector v 0 endIndex) <$> V.unsafeFreeze buff
-
-    pure $ RadianceHeader
-        { radianceInfos = []
-        , radianceFormat = FormatRGBE
-        , radianceHeight = h
-        , radianceWidth  = w
-        , radianceData = L.fromChunks encoded 
-        }
-    
-
-decodeRadiancePicture :: RadianceHeader -> HDRReader s (MutableImage s (PixelRGBF))
-decodeRadiancePicture hdr = do
-    let width = abs $ radianceWidth hdr
-        height = abs $ radianceHeight hdr
-        packedData = radianceData hdr
-
-    scanLine <- lift $ M.new $ width * 4
-    resultBuffer <- lift $ M.new $ width * height * 3
-
-    let scanLineImage = MutableImage
-                      { mutableImageWidth = width
-                      , mutableImageHeight = 1
-                      , mutableImageData = scanLine
-                      }
-
-        finalImage = MutableImage
-                   { mutableImageWidth = width
-                   , mutableImageHeight = height
-                   , mutableImageData = resultBuffer
-                   }
-
-    let scanLineExtractor readIdx line = do
-          let color = unpackColor packedData readIdx
-              inner | isNewRunLengthMarker color = do
-                          let calcSize = checkLineLength color
-                          when (calcSize /= width)
-                               (throwError "Invalid sanline size")
-                          pure $ \idx -> newStyleRLE packedData (idx + 4)
-                    | otherwise = pure $ oldStyleRLE packedData
-          f <- inner
-          newRead <- f readIdx scanLine
-          forM_ [0 .. width - 1] $ \i -> do
-              -- mokay, it's a hack, but I don't want to define a
-              -- pixel instance of RGBE...
-              PixelRGBA8 r g b e <- lift $ readPixel scanLineImage i 0
-              lift $ writePixel finalImage i line . toFloat $ RGBE r g b e
-
-          return newRead
-
-    foldM_ scanLineExtractor 0 [0 .. height - 1]
-
-    return finalImage
-

@@ -1,33 +0,0 @@-module Codec.Picture.InternalHelper ( runGet
-                                    , runGetStrict
-                                    , decode
-                                    , getRemainingBytes
-                                    , getRemainingLazyBytes ) where
-
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Lazy as L
-import Data.Binary( Binary( get ) )
-import Data.Binary.Get( Get, runGetOrFail, getRemainingLazyByteString )
-
-decode :: (Binary a) => B.ByteString -> Either String a
-decode = runGetStrict get
-
-runGet :: Get a -> L.ByteString -> Either String a
-runGet act = unpack . runGetOrFail act
-    where unpack (Left (_, _, str)) = Left str
-          unpack (Right (_, _, element)) = Right element
-
-runGetStrict :: Get a -> B.ByteString -> Either String a
-runGetStrict act buffer = runGet act $ L.fromChunks [buffer]
-
-getRemainingBytes :: Get B.ByteString
-getRemainingBytes = do
-    rest <- getRemainingLazyByteString 
-    return $ case L.toChunks rest of
-        [] -> B.empty
-        [a] -> a
-        lst -> B.concat lst
-
-getRemainingLazyBytes :: Get L.ByteString
-getRemainingLazyBytes = getRemainingLazyByteString 
-

@@ -1,720 +0,0 @@-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE BangPatterns #-}
-{-# OPTIONS_GHC -fspec-constr-count=5 #-}
--- | Module used for JPEG file loading and writing.
-module Codec.Picture.Jpg( decodeJpeg
-                        , encodeJpegAtQuality
-                        , encodeJpeg
-
-                        , jpgMachineStep
-                        , JpgDecoderState( JpgDecoderState )
-                        ) where
-
-import Control.Arrow( (>>>) )
-import Control.Applicative( pure, (<$>) )
-import Control.Monad( when, forM_ )
-import Control.Monad.ST( ST, runST )
-import Control.Monad.Trans( lift )
-import Control.Monad.Trans.RWS.Strict( RWS, modify, tell, gets, execRWS )
-
-import Data.Bits( (.|.), unsafeShiftL )
-import Data.Int( Int16, Int32 )
-import Data.Word(Word8, Word32)
-import Data.Binary( Binary(..), encode )
-import Data.STRef( newSTRef, writeSTRef, readSTRef )
-
-import Data.Vector( (//) )
-import Data.Vector.Unboxed( (!) )
-import qualified Data.Vector as V
-import qualified Data.Vector.Unboxed as VU
-import qualified Data.Vector.Storable as VS
-import qualified Data.Vector.Storable.Mutable as M
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Lazy as L
-
-import Codec.Picture.InternalHelper
-import Codec.Picture.BitWriter
-import Codec.Picture.Types
-import Codec.Picture.Jpg.Types
-import Codec.Picture.Jpg.Common
-import Codec.Picture.Jpg.Progressive
-import Codec.Picture.Jpg.DefaultTable
-import Codec.Picture.Jpg.FastDct
-
-quantize :: MacroBlock Int16 -> MutableMacroBlock s Int32
-         -> ST s (MutableMacroBlock s Int32)
-quantize table block = update 0
-  where update 64 = return block
-        update idx = do
-            val <- block `M.unsafeRead` idx
-            let q = fromIntegral (table `VS.unsafeIndex` idx)
-                finalValue = (val + (q `div` 2)) `quot` q -- rounded integer division
-            (block `M.unsafeWrite` idx) finalValue
-            update $ idx + 1
-
-
-powerOf :: Int32 -> Word32
-powerOf 0 = 0
-powerOf n = limit 1 0
-    where val = abs n
-          limit range i | val < range = i
-          limit range i = limit (2 * range) (i + 1)
-
-encodeInt :: BoolWriteStateRef s -> Word32 -> Int32 -> ST s ()
-{-# INLINE encodeInt #-}
-encodeInt st ssss n | n > 0 = writeBits' st (fromIntegral n) (fromIntegral ssss)
-encodeInt st ssss n         = writeBits' st (fromIntegral $ n - 1) (fromIntegral ssss)
-
--- | Assume the macro block is initialized with zeroes
-acCoefficientsDecode :: HuffmanPackedTree -> MutableMacroBlock s Int16
-                     -> BoolReader s (MutableMacroBlock s Int16)
-acCoefficientsDecode acTree mutableBlock = parseAcCoefficient 1 >> return mutableBlock
-  where parseAcCoefficient n | n >= 64 = return ()
-                             | otherwise = do
-            rrrrssss <- decodeRrrrSsss acTree
-            case rrrrssss of
-                (  0, 0) -> return ()
-                (0xF, 0) -> parseAcCoefficient (n + 16)
-                (rrrr, ssss) -> do
-                    decoded <- fromIntegral <$> decodeInt ssss
-                    lift $ (mutableBlock `M.unsafeWrite` (n + rrrr)) decoded
-                    parseAcCoefficient (n + rrrr + 1)
-
--- | Decompress a macroblock from a bitstream given the current configuration
--- from the frame.
-decompressMacroBlock :: HuffmanPackedTree   -- ^ Tree used for DC coefficient
-                     -> HuffmanPackedTree   -- ^ Tree used for Ac coefficient
-                     -> MacroBlock Int16    -- ^ Current quantization table
-                     -> MutableMacroBlock s Int16    -- ^ A zigzag table, to avoid allocation
-                     -> DcCoefficient       -- ^ Previous dc value
-                     -> BoolReader s (DcCoefficient, MutableMacroBlock s Int16)
-decompressMacroBlock dcTree acTree quantizationTable zigzagBlock previousDc = do
-    dcDeltaCoefficient <- dcCoefficientDecode dcTree
-    block <- lift createEmptyMutableMacroBlock
-    let neoDcCoefficient = previousDc + dcDeltaCoefficient
-    lift $ (block `M.unsafeWrite` 0) neoDcCoefficient
-    fullBlock <- acCoefficientsDecode acTree block
-    decodedBlock <- lift $ decodeMacroBlock quantizationTable zigzagBlock fullBlock
-    return (neoDcCoefficient, decodedBlock)
-
-pixelClamp :: Int16 -> Word8
-pixelClamp n = fromIntegral . min 255 $ max 0 n
-
-unpack444Y :: Int -- ^ component index
-           -> Int -- ^ x
-           -> Int -- ^ y
-           -> MutableImage s PixelYCbCr8
-           -> MutableMacroBlock s Int16
-           -> ST s ()
-unpack444Y _ x y (MutableImage { mutableImageWidth = imgWidth, mutableImageData = img })
-                 block = blockVert baseIdx 0 zero
-  where zero = 0 :: Int
-        baseIdx = x * dctBlockSize + y * dctBlockSize * imgWidth
-
-        blockVert        _       _ j | j >= dctBlockSize = return ()
-        blockVert writeIdx readingIdx j = blockHoriz writeIdx readingIdx zero
-          where blockHoriz   _ readIdx i | i >= dctBlockSize = blockVert (writeIdx + imgWidth) readIdx $ j + 1
-                blockHoriz idx readIdx i = do
-                    val <- pixelClamp <$> (block `M.unsafeRead` readIdx)
-                    (img `M.unsafeWrite` idx) val
-                    blockHoriz (idx + 1) (readIdx + 1) $ i + 1
-
-unpack444Ycbcr :: Int -- ^ Component index
-              -> Int -- ^ x
-              -> Int -- ^ y
-              -> MutableImage s PixelYCbCr8
-              -> MutableMacroBlock s Int16
-              -> ST s ()
-unpack444Ycbcr compIdx x y
-                 (MutableImage { mutableImageWidth = imgWidth, mutableImageData = img })
-                 block = blockVert baseIdx 0 zero
-  where zero = 0 :: Int
-        baseIdx = (x * dctBlockSize + y * dctBlockSize * imgWidth) * 3 + compIdx
-
-        blockVert   _       _ j | j >= dctBlockSize = return ()
-        blockVert idx readIdx j = do
-            val0 <- pixelClamp <$> (block `M.unsafeRead` readIdx)
-            val1 <- pixelClamp <$> (block `M.unsafeRead` (readIdx + 1))
-            val2 <- pixelClamp <$> (block `M.unsafeRead` (readIdx + 2))
-            val3 <- pixelClamp <$> (block `M.unsafeRead` (readIdx + 3))
-            val4 <- pixelClamp <$> (block `M.unsafeRead` (readIdx + 4))
-            val5 <- pixelClamp <$> (block `M.unsafeRead` (readIdx + 5))
-            val6 <- pixelClamp <$> (block `M.unsafeRead` (readIdx + 6))
-            val7 <- pixelClamp <$> (block `M.unsafeRead` (readIdx + 7))
-
-            (img `M.unsafeWrite` idx) val0
-            (img `M.unsafeWrite` (idx + (3 * 1))) val1
-            (img `M.unsafeWrite` (idx + (3 * 2))) val2
-            (img `M.unsafeWrite` (idx + (3 * 3))) val3
-            (img `M.unsafeWrite` (idx + (3 * 4))) val4
-            (img `M.unsafeWrite` (idx + (3 * 5))) val5
-            (img `M.unsafeWrite` (idx + (3 * 6))) val6
-            (img `M.unsafeWrite` (idx + (3 * 7))) val7
-
-            blockVert (idx + 3 * imgWidth) (readIdx + dctBlockSize) $ j + 1
-
-
-          {-where blockHoriz   _ readIdx i | i >= 8 = blockVert (writeIdx + imgWidth * 3) readIdx $ j + 1-}
-                {-blockHoriz idx readIdx i = do-}
-                    {-val <- pixelClamp <$> (block `M.unsafeRead` readIdx) -}
-                    {-(img `M.unsafeWrite` idx) val-}
-                    {-blockHoriz (idx + 3) (readIdx + 1) $ i + 1-}
-
-unpack421Ycbcr :: Int -- ^ Component index
-               -> Int -- ^ x
-               -> Int -- ^ y
-               -> MutableImage s PixelYCbCr8
-               -> MutableMacroBlock s Int16
-               -> ST s ()
-unpack421Ycbcr compIdx x y
-                 (MutableImage { mutableImageWidth = imgWidth,
-                                 mutableImageHeight = _, mutableImageData = img })
-                 block = blockVert baseIdx 0 zero
-  where zero = 0 :: Int
-        baseIdx = (x * dctBlockSize + y * dctBlockSize * imgWidth) * 3 + compIdx
-        lineOffset = imgWidth * 3
-
-        blockVert        _       _ j | j >= dctBlockSize = return ()
-        blockVert idx readIdx j = do
-            v0 <- pixelClamp <$> (block `M.unsafeRead` readIdx)
-            v1 <- pixelClamp <$> (block `M.unsafeRead` (readIdx + 1))
-            v2 <- pixelClamp <$> (block `M.unsafeRead` (readIdx + 2))
-            v3 <- pixelClamp <$> (block `M.unsafeRead` (readIdx + 3))
-            v4 <- pixelClamp <$> (block `M.unsafeRead` (readIdx + 4))
-            v5 <- pixelClamp <$> (block `M.unsafeRead` (readIdx + 5))
-            v6 <- pixelClamp <$> (block `M.unsafeRead` (readIdx + 6))
-            v7 <- pixelClamp <$> (block `M.unsafeRead` (readIdx + 7))
-
-            (img `M.unsafeWrite` idx)       v0
-            (img `M.unsafeWrite` (idx + 3)) v0
-
-            (img `M.unsafeWrite` (idx + 6 * 1))      v1
-            (img `M.unsafeWrite` (idx + 6 * 1 + 3))  v1
-
-            (img `M.unsafeWrite` (idx + 6 * 2))      v2
-            (img `M.unsafeWrite` (idx + 6 * 2 + 3))  v2
-
-            (img `M.unsafeWrite` (idx + 6 * 3))      v3
-            (img `M.unsafeWrite` (idx + 6 * 3 + 3))  v3
-
-            (img `M.unsafeWrite` (idx + 6 * 4))      v4
-            (img `M.unsafeWrite` (idx + 6 * 4 + 3))  v4
-
-            (img `M.unsafeWrite` (idx + 6 * 5))      v5
-            (img `M.unsafeWrite` (idx + 6 * 5 + 3))  v5
-
-            (img `M.unsafeWrite` (idx + 6 * 6))      v6
-            (img `M.unsafeWrite` (idx + 6 * 6 + 3))  v6
-
-            (img `M.unsafeWrite` (idx + 6 * 7))      v7
-            (img `M.unsafeWrite` (idx + 6 * 7 + 3))  v7
-
-            blockVert (idx + lineOffset) (readIdx + dctBlockSize) $ j + 1
-
-type Unpacker s = Int -- ^ component index
-               -> Int -- ^ x
-               -> Int -- ^ y
-               -> MutableImage s PixelYCbCr8
-               -> MutableMacroBlock s Int16
-               -> ST s ()
-
-type JpgScripter s a =
-    RWS () [([(JpgUnpackerParameter, Unpacker s)], L.ByteString)] JpgDecoderState a
-
-data JpgDecoderState = JpgDecoderState
-    { dcDecoderTables      :: !(V.Vector HuffmanPackedTree)
-    , acDecoderTables      :: !(V.Vector HuffmanPackedTree)
-    , quantizationMatrices :: !(V.Vector (MacroBlock Int16))
-    , currentRestartInterv :: !Int
-    , currentFrame         :: Maybe JpgFrameHeader
-    , isProgressive        :: !Bool
-    , maximumHorizontalResolution :: !Int
-    , maximumVerticalResolution   :: !Int
-    , seenBlobs                   :: !Int
-    }
-
-emptyDecoderState :: JpgDecoderState
-emptyDecoderState = JpgDecoderState
-    { dcDecoderTables = V.fromList $ map snd
-            [ prepareHuffmanTable DcComponent 0 defaultDcLumaHuffmanTable
-            , prepareHuffmanTable DcComponent 1 defaultDcChromaHuffmanTable
-            ]
-
-    , acDecoderTables = V.fromList $ map snd
-            [ prepareHuffmanTable AcComponent 0 defaultAcLumaHuffmanTable
-            , prepareHuffmanTable AcComponent 1 defaultAcChromaHuffmanTable
-            ]
-
-    , quantizationMatrices = V.replicate 4 (VS.replicate (8 * 8) 1)
-    , currentRestartInterv = -1
-    , currentFrame         = Nothing
-    , isProgressive        = False
-    , maximumHorizontalResolution = 0
-    , maximumVerticalResolution   = 0
-    , seenBlobs = 0
-    }
-
--- | This pseudo interpreter interpret the Jpg frame for the huffman,
--- quant table and restart interval parameters.
-jpgMachineStep :: JpgFrame -> JpgScripter s ()
-jpgMachineStep (JpgAppFrame _ _) = pure ()
-jpgMachineStep (JpgExtension _ _) = pure ()
-jpgMachineStep (JpgScanBlob hdr raw_data) = do
-    let scanCount = length $ scans hdr
-    params <- concat <$> mapM (scanSpecifier scanCount) (scans hdr)
-    modify $ \st -> st { seenBlobs = seenBlobs st + 1 }
-    tell [(params, raw_data)  ]
-  where (selectionLow, selectionHigh) = spectralSelection hdr
-        approxHigh = fromIntegral $ successiveApproxHigh hdr
-        approxLow = fromIntegral $ successiveApproxLow hdr
-        
-        scanSpecifier scanCount scanSpec = do
-            let dcIndex = fromIntegral $ dcEntropyCodingTable scanSpec
-                acIndex = fromIntegral $ acEntropyCodingTable scanSpec
-                comp = fromIntegral (componentSelector scanSpec) - 1
-            dcTree <- gets $ (V.! dcIndex) . dcDecoderTables
-            acTree <- gets $ (V.! acIndex) . acDecoderTables
-            isProgressiveImage <- gets isProgressive
-            maxiW <- gets maximumHorizontalResolution 
-            maxiH <- gets maximumVerticalResolution
-            restart <- gets currentRestartInterv
-            frameInfo <- gets currentFrame
-            blobId <- gets seenBlobs                   
-            case frameInfo of
-              Nothing -> fail "Jpg decoding error - no previous frame"
-              Just v -> do
-                 let compDesc = jpgComponents v !! comp
-                     compCount = length $ jpgComponents v
-                     xSampling = fromIntegral $ horizontalSamplingFactor compDesc
-                     ySampling = fromIntegral $ verticalSamplingFactor compDesc
-                     componentSubSampling =
-                        (maxiW - xSampling + 1, maxiH - ySampling + 1)
-                     (xCount, yCount)
-                        | scanCount > 1 || isProgressiveImage = (xSampling, ySampling)
-                        | otherwise = (1, 1)
-
-                 pure [ (JpgUnpackerParameter
-                         { dcHuffmanTree = dcTree
-                         , acHuffmanTree = acTree
-                         , componentIndex = comp
-                         , restartInterval = fromIntegral restart
-                         , componentWidth = xSampling
-                         , componentHeight = ySampling
-                         , subSampling = componentSubSampling
-                         , successiveApprox = (approxLow, approxHigh)
-                         , readerIndex = blobId
-                         , indiceVector =
-                             if selectionLow == 0 then 0 else 1
-                         , coefficientRange =
-                             ( fromIntegral selectionLow
-                             , fromIntegral selectionHigh )
-                         , blockIndex = y * ySampling + x
-                         , blockMcuX = x
-                         , blockMcuY = y
-                         }, unpackerDecision compCount componentSubSampling)
-                             | y <- [0 .. yCount - 1]
-                             , x <- [0 .. xCount - 1] ]
-
-jpgMachineStep (JpgScans kind hdr) = modify $ \s ->
-   s { currentFrame = Just hdr
-     , isProgressive = case kind of
-            JpgProgressiveDCTHuffman -> True
-            _ -> False
-     , maximumHorizontalResolution =
-         fromIntegral $ maximum horizontalResolutions
-     , maximumVerticalResolution =
-         fromIntegral $ maximum verticalResolutions
-     }
-    where components = jpgComponents hdr
-          horizontalResolutions = map horizontalSamplingFactor components
-          verticalResolutions = map verticalSamplingFactor components
-jpgMachineStep (JpgIntervalRestart restart) =
-    modify $ \s -> s { currentRestartInterv = fromIntegral restart }
-jpgMachineStep (JpgHuffmanTable tables) = mapM_ placeHuffmanTrees tables
-  where placeHuffmanTrees (spec, tree) = case huffmanTableClass spec of
-            DcComponent -> modify $ \s ->
-                let neu = dcDecoderTables s // [(idx, tree)] in 
-                s { dcDecoderTables = neu `seq` neu }
-                    where idx = fromIntegral $ huffmanTableDest spec
-                          
-            AcComponent -> modify $ \s ->
-                s { acDecoderTables = acDecoderTables s // [(idx, tree)] }
-                    where idx = fromIntegral $ huffmanTableDest spec
-
-jpgMachineStep (JpgQuantTable tables) = mapM_ placeQuantizationTables tables
-  where placeQuantizationTables table = do
-            let idx = fromIntegral $ quantDestination table
-                tableData = quantTable table
-            modify $ \s ->
-                s { quantizationMatrices =  quantizationMatrices s // [(idx, tableData)] }
-
-unpackerDecision :: Int -> (Int, Int) -> Unpacker s
-unpackerDecision 1 (1, 1) = unpack444Y
-unpackerDecision _ (1, 1) = unpack444Ycbcr
-unpackerDecision _ (2, 1) = unpack421Ycbcr
-unpackerDecision compCount (xScalingFactor, yScalingFactor) =
-    unpackMacroBlock compCount xScalingFactor yScalingFactor
-
-decodeImage :: JpgFrameHeader
-            -> V.Vector (MacroBlock Int16)
-            -> [([(JpgUnpackerParameter, Unpacker s)], L.ByteString)]
-            -> MutableImage s PixelYCbCr8 -- ^ Result image to write into
-            -> ST s ()
-decodeImage frame quants lst outImage = do
-  let compCount = length $ jpgComponents frame
-  zigZagArray <- createEmptyMutableMacroBlock
-  dcArray <- M.replicate compCount 0  :: ST s (M.STVector s DcCoefficient)
-  resetCounter <- newSTRef restartIntervalValue
-
-  forM_ lst $ \(params, str) -> do
-    let componentsInfo = V.fromList params
-        compReader = initBoolStateJpg . B.concat $ L.toChunks str
-        maxiW = maximum [fst $ subSampling c | (c,_) <- params]
-        maxiH = maximum [snd $ subSampling c | (c,_) <- params]
-        mcuBlockWidth = maxiW * dctBlockSize
-        mcuBlockHeight = maxiH * dctBlockSize
-        imageMcuWidth = (imgWidth + mcuBlockWidth - 1) `div` mcuBlockWidth
-        imageMcuHeight = (imgHeight + mcuBlockHeight - 1) `div` mcuBlockHeight 
-
-    execBoolReader compReader $ rasterMap imageMcuWidth imageMcuHeight $ \x y -> do
-      resetLeft <- lift $ readSTRef resetCounter
-      if resetLeft == 0 then do
-        lift $ M.set dcArray 0
-        byteAlignJpg
-        _restartCode <- decodeRestartInterval
-        lift $ resetCounter `writeSTRef` (restartIntervalValue - 1)
-      else
-        lift $ resetCounter `writeSTRef` (resetLeft - 1)
-
-      V.forM_ componentsInfo $ \(comp, unpack) -> do
-        let compIdx = componentIndex comp
-            dcTree = dcHuffmanTree comp
-            acTree = acHuffmanTree comp
-            qTable = quants V.! (min 1 compIdx)
-            xd = blockMcuX comp
-            yd = blockMcuY comp
-            (subX, subY) = subSampling comp
-        dc <- lift $ dcArray `M.unsafeRead` compIdx
-        (dcCoeff, block) <-
-              decompressMacroBlock dcTree acTree qTable zigZagArray $ fromIntegral dc
-        lift $ (dcArray `M.unsafeWrite` compIdx) dcCoeff
-        let verticalLimited = y == imageMcuHeight - 1
-        if (x == imageMcuWidth - 1) || verticalLimited then
-          lift $ unpackMacroBlock imgComponentCount
-                                  subX subY compIdx
-                                  (x * maxiW + xd) (y * maxiH + yd) outImage block
-        else
-          lift $ unpack compIdx (x * maxiW + xd) (y * maxiH + yd) outImage block
-
-  where imgComponentCount = length $ jpgComponents frame
-
-        imgWidth = fromIntegral $ jpgWidth frame
-        imgHeight = fromIntegral $ jpgHeight frame
-        restartIntervalValue = case lst of
-                ((p,_):_,_): _ -> restartInterval p
-                _ -> -1
-
-gatherImageKind :: [JpgFrame] -> Maybe JpgImageKind
-gatherImageKind lst = case [k | JpgScans k _ <- lst, isDctSpecifier k] of
-    [JpgBaselineDCTHuffman] -> Just BaseLineDCT
-    [JpgProgressiveDCTHuffman] -> Just ProgressiveDCT
-    _ -> Nothing
-  where isDctSpecifier JpgProgressiveDCTHuffman = True
-        isDctSpecifier JpgBaselineDCTHuffman = True
-        isDctSpecifier _ = False
-
-gatherScanInfo :: JpgImage -> (JpgFrameKind, JpgFrameHeader)
-gatherScanInfo img = head [(a, b) | JpgScans a b <- jpgFrame img]
-
--- | Try to decompress a jpeg file and decompress. The colorspace is still
--- YCbCr if you want to perform computation on the luma part. You can
--- convert it to RGB using 'convertImage' from the 'ColorSpaceConvertible'
--- typeclass.
---
--- This function can output the following pixel types :
---
---    * PixelY8
---
---    * PixelYCbCr8
---
-decodeJpeg :: B.ByteString -> Either String DynamicImage
-decodeJpeg file = case runGetStrict get file of
-  Left err -> Left err
-  Right img -> case (compCount, imgKind) of
-                 (_, Nothing) -> Left "Unknown Jpg kind"
-                 (3, Just ProgressiveDCT) -> Right . ImageYCbCr8 $ decodeProgressive
-                 (1, Just BaseLineDCT) -> Right . ImageY8 $ Image imgWidth imgHeight pixelData
-                 (3, Just BaseLineDCT) -> Right . ImageYCbCr8 $ Image imgWidth imgHeight pixelData
-                 _ -> Left "Wrong component count"
-
-      where compCount = length $ jpgComponents scanInfo
-            (_,scanInfo) = gatherScanInfo img
-
-            imgKind = gatherImageKind $ jpgFrame img
-            imgWidth = fromIntegral $ jpgWidth scanInfo
-            imgHeight = fromIntegral $ jpgHeight scanInfo
-
-            imageSize = imgWidth * imgHeight * compCount
-            (st, wrotten) = execRWS (mapM_ jpgMachineStep (jpgFrame img)) () emptyDecoderState
-            Just fHdr = currentFrame st
-
-            decodeProgressive = runST $
-                progressiveUnpack
-                    (maximumHorizontalResolution st, maximumVerticalResolution st)
-                    fHdr
-                    (quantizationMatrices st)
-                    wrotten >>= unsafeFreezeImage
-
-            pixelData = runST $ do
-                resultImage <- M.new imageSize
-                let wrapped = MutableImage imgWidth imgHeight resultImage
-                decodeImage 
-                    fHdr
-                    (quantizationMatrices st)
-                    wrotten
-                    wrapped
-                VS.unsafeFreeze resultImage
-
-extractBlock :: Image PixelYCbCr8       -- ^ Source image
-             -> MutableMacroBlock s Int16      -- ^ Mutable block where to put extracted block
-             -> Int                     -- ^ Plane
-             -> Int                     -- ^ X sampling factor
-             -> Int                     -- ^ Y sampling factor
-             -> Int                     -- ^ Sample per pixel
-             -> Int                     -- ^ Block x
-             -> Int                     -- ^ Block y
-             -> ST s (MutableMacroBlock s Int16)
-extractBlock (Image { imageWidth = w, imageHeight = h, imageData = src })
-             block 1 1 sampCount plane bx by | (bx * dctBlockSize) + 7 < w && (by * 8) + 7 < h = do
-    let baseReadIdx = (by * dctBlockSize * w) + bx * dctBlockSize
-    sequence_ [(block `M.unsafeWrite` (y * dctBlockSize + x)) val
-                        | y <- [0 .. dctBlockSize - 1]
-                        , let blockReadIdx = baseReadIdx + y * w
-                        , x <- [0 .. dctBlockSize - 1]
-                        , let val = fromIntegral $ src `VS.unsafeIndex` ((blockReadIdx + x) * sampCount + plane)
-                        ]
-    return block
-extractBlock (Image { imageWidth = w, imageHeight = h, imageData = src })
-             block sampWidth sampHeight sampCount plane bx by = do
-    let accessPixel x y | x < w && y < h = let idx = (y * w + x) * sampCount + plane in src `VS.unsafeIndex` idx
-                        | x >= w = accessPixel (w - 1) y
-                        | otherwise = accessPixel x (h - 1)
-
-        pixelPerCoeff = fromIntegral $ sampWidth * sampHeight
-
-        blockVal x y = sum [fromIntegral $ accessPixel (xBase + dx) (yBase + dy)
-                                | dy <- [0 .. sampHeight - 1]
-                                , dx <- [0 .. sampWidth - 1] ] `div` pixelPerCoeff
-            where xBase = blockXBegin + x * sampWidth
-                  yBase = blockYBegin + y * sampHeight
-
-        blockXBegin = bx * dctBlockSize * sampWidth
-        blockYBegin = by * dctBlockSize * sampHeight
-
-    sequence_ [(block `M.unsafeWrite` (y * dctBlockSize + x)) $ blockVal x y | y <- [0 .. 7], x <- [0 .. 7] ]
-    return block
-
-serializeMacroBlock :: BoolWriteStateRef s
-                    -> HuffmanWriterCode -> HuffmanWriterCode
-                    -> MutableMacroBlock s Int32
-                    -> ST s ()
-serializeMacroBlock !st !dcCode !acCode !blk =
- (blk `M.unsafeRead` 0) >>= (fromIntegral >>> encodeDc) >> writeAcs (0, 1) >> return ()
-  where writeAcs acc@(_, 63) =
-            (blk `M.unsafeRead` 63) >>= (fromIntegral >>> encodeAcCoefs acc) >> return ()
-        writeAcs acc@(_, i ) =
-            (blk `M.unsafeRead`  i) >>= (fromIntegral >>> encodeAcCoefs acc) >>= writeAcs
-
-        encodeDc n = writeBits' st (fromIntegral code) (fromIntegral bitCount)
-                        >> when (ssss /= 0) (encodeInt st ssss n)
-            where ssss = powerOf $ fromIntegral n
-                  (bitCount, code) = dcCode `V.unsafeIndex` fromIntegral ssss
-
-        encodeAc 0         0 = writeBits' st (fromIntegral code) $ fromIntegral bitCount
-            where (bitCount, code) = acCode `V.unsafeIndex` 0
-
-        encodeAc zeroCount n | zeroCount >= 16 =
-          writeBits' st (fromIntegral code) (fromIntegral bitCount) >>  encodeAc (zeroCount - 16) n
-            where (bitCount, code) = acCode `V.unsafeIndex` 0xF0
-        encodeAc zeroCount n =
-          writeBits' st (fromIntegral code) (fromIntegral bitCount) >> encodeInt st ssss n
-            where rrrr = zeroCount `unsafeShiftL` 4
-                  ssss = powerOf $ fromIntegral n
-                  rrrrssss = rrrr .|. ssss
-                  (bitCount, code) = acCode `V.unsafeIndex` fromIntegral rrrrssss
-
-        encodeAcCoefs (            _, 63) 0 = encodeAc 0 0 >> return (0, 64)
-        encodeAcCoefs (zeroRunLength,  i) 0 = return (zeroRunLength + 1, i + 1)
-        encodeAcCoefs (zeroRunLength,  i) n =
-            encodeAc zeroRunLength n >> return (0, i + 1)
-
-encodeMacroBlock :: QuantificationTable
-                 -> MutableMacroBlock s Int32
-                 -> MutableMacroBlock s Int32
-                 -> Int16
-                 -> MutableMacroBlock s Int16
-                 -> ST s (Int32, MutableMacroBlock s Int32)
-encodeMacroBlock quantTableOfComponent workData finalData prev_dc block = do
- -- the inverse level shift is performed internally by the fastDCT routine
- blk <- fastDctLibJpeg workData block
-        >>= zigZagReorderForward finalData
-        >>= quantize quantTableOfComponent
- dc <- blk `M.unsafeRead` 0
- (blk `M.unsafeWrite` 0) $ dc - fromIntegral prev_dc
- return (dc, blk)
-
-divUpward :: (Integral a) => a -> a -> a
-divUpward n dividor = val + (if rest /= 0 then 1 else 0)
-    where (val, rest) = n `divMod` dividor
-
-prepareHuffmanTable :: DctComponent -> Word8 -> HuffmanTable
-                    -> (JpgHuffmanTableSpec, HuffmanPackedTree)
-prepareHuffmanTable classVal dest tableDef =
-   (JpgHuffmanTableSpec { huffmanTableClass = classVal
-                        , huffmanTableDest  = dest
-                        , huffSizes = sizes
-                        , huffCodes = V.fromListN 16
-                            [VU.fromListN (fromIntegral $ sizes ! i) lst
-                                                | (i, lst) <- zip [0..] tableDef ]
-                        }, VS.singleton 0)
-      where sizes = VU.fromListN 16 $ map (fromIntegral . length) tableDef
-
--- | Encode an image in jpeg at a reasonnable quality level.
--- If you want better quality or reduced file size, you should
--- use `encodeJpegAtQuality`
-encodeJpeg :: Image PixelYCbCr8 -> L.ByteString
-encodeJpeg = encodeJpegAtQuality 50
-
-defaultHuffmanTables :: [(JpgHuffmanTableSpec, HuffmanPackedTree)]
-defaultHuffmanTables =
-    [ prepareHuffmanTable DcComponent 0 defaultDcLumaHuffmanTable
-    , prepareHuffmanTable AcComponent 0 defaultAcLumaHuffmanTable
-    , prepareHuffmanTable DcComponent 1 defaultDcChromaHuffmanTable
-    , prepareHuffmanTable AcComponent 1 defaultAcChromaHuffmanTable
-    ]
-
--- | Function to call to encode an image to jpeg.
--- The quality factor should be between 0 and 100 (100 being
--- the best quality).
-encodeJpegAtQuality :: Word8                -- ^ Quality factor
-                    -> Image PixelYCbCr8    -- ^ Image to encode
-                    -> L.ByteString         -- ^ Encoded JPEG
-encodeJpegAtQuality quality img@(Image { imageWidth = w, imageHeight = h }) = encode finalImage
-  where finalImage = JpgImage [ JpgQuantTable quantTables
-                              , JpgScans JpgBaselineDCTHuffman hdr
-                              , JpgHuffmanTable defaultHuffmanTables
-                              , JpgScanBlob scanHeader encodedImage
-                              ]
-
-        outputComponentCount = 3
-
-        scanHeader = scanHeader'{ scanLength = fromIntegral $ calculateSize scanHeader' }
-        scanHeader' = JpgScanHeader
-            { scanLength = 0
-            , scanComponentCount = outputComponentCount
-            , scans = [ JpgScanSpecification { componentSelector = 1
-                                             , dcEntropyCodingTable = 0
-                                             , acEntropyCodingTable = 0
-                                             }
-                      , JpgScanSpecification { componentSelector = 2
-                                             , dcEntropyCodingTable = 1
-                                             , acEntropyCodingTable = 1
-                                             }
-                      , JpgScanSpecification { componentSelector = 3
-                                             , dcEntropyCodingTable = 1
-                                             , acEntropyCodingTable = 1
-                                             }
-                      ]
-
-            , spectralSelection = (0, 63)
-            , successiveApproxHigh = 0
-            , successiveApproxLow  = 0
-            }
-
-        hdr = hdr' { jpgFrameHeaderLength   = fromIntegral $ calculateSize hdr' }
-        hdr' = JpgFrameHeader { jpgFrameHeaderLength   = 0
-                              , jpgSamplePrecision     = 8
-                              , jpgHeight              = fromIntegral h
-                              , jpgWidth               = fromIntegral w
-                              , jpgImageComponentCount = outputComponentCount
-                              , jpgComponents          = [
-                                    JpgComponent { componentIdentifier      = 1
-                                                 , horizontalSamplingFactor = 2
-                                                 , verticalSamplingFactor   = 2
-                                                 , quantizationTableDest    = 0
-                                                 }
-                                  , JpgComponent { componentIdentifier      = 2
-                                                 , horizontalSamplingFactor = 1
-                                                 , verticalSamplingFactor   = 1
-                                                 , quantizationTableDest    = 1
-                                                 }
-                                  , JpgComponent { componentIdentifier      = 3
-                                                 , horizontalSamplingFactor = 1
-                                                 , verticalSamplingFactor   = 1
-                                                 , quantizationTableDest    = 1
-                                                 }
-                                  ]
-                              }
-
-        lumaQuant = scaleQuantisationMatrix (fromIntegral quality)
-                        defaultLumaQuantizationTable
-        chromaQuant = scaleQuantisationMatrix (fromIntegral quality)
-                            defaultChromaQuantizationTable
-
-        zigzagedLumaQuant = zigZagReorderForwardv lumaQuant
-        zigzagedChromaQuant = zigZagReorderForwardv chromaQuant
-        quantTables = [ JpgQuantTableSpec { quantPrecision = 0, quantDestination = 0
-                                          , quantTable = zigzagedLumaQuant }
-                      , JpgQuantTableSpec { quantPrecision = 0, quantDestination = 1
-                                          , quantTable = zigzagedChromaQuant }
-                      ]
-
-        encodedImage = runST $ do
-            let horizontalMetaBlockCount =
-                    w `divUpward` (dctBlockSize * maxSampling)
-                verticalMetaBlockCount =
-                    h `divUpward` (dctBlockSize * maxSampling)
-                maxSampling = 2
-                lumaSamplingSize = ( maxSampling, maxSampling, zigzagedLumaQuant
-                                   , makeInverseTable defaultDcLumaHuffmanTree
-                                   , makeInverseTable defaultAcLumaHuffmanTree)
-                chromaSamplingSize = ( maxSampling - 1, maxSampling - 1, zigzagedChromaQuant
-                                     , makeInverseTable defaultDcChromaHuffmanTree
-                                     , makeInverseTable defaultAcChromaHuffmanTree)
-                componentDef = [lumaSamplingSize, chromaSamplingSize, chromaSamplingSize]
-
-                imageComponentCount = length componentDef
-
-            dc_table <- M.replicate 3 0
-            block <- createEmptyMutableMacroBlock
-            workData <- createEmptyMutableMacroBlock
-            zigzaged <- createEmptyMutableMacroBlock
-            writeState <- newWriteStateRef
-
-            -- It's ugly, I know, be avoid allocation
-            let blockDecoder mx my = component $ zip [0..] componentDef
-                  where component [] = return ()
-                        component ((comp, (sizeX, sizeY, table, dc, ac)) : comp_rest) =
-                           rasterMap sizeX sizeY decoder >> component comp_rest
-                          where xSamplingFactor = maxSampling - sizeX + 1
-                                ySamplingFactor = maxSampling - sizeY + 1
-                                extractor = extractBlock img block xSamplingFactor ySamplingFactor imageComponentCount
-
-                                decoder subX subY = do
-                                  let blockY = my * sizeY + subY
-                                      blockX = mx * sizeX + subX
-                                  prev_dc <- dc_table `M.unsafeRead` comp
-                                  (dc_coeff, neo_block) <- (extractor comp blockX blockY >>=
-                                                          encodeMacroBlock table workData zigzaged prev_dc)
-                                  (dc_table `M.unsafeWrite` comp) $ fromIntegral dc_coeff
-                                  serializeMacroBlock writeState dc ac neo_block
-
-            rasterMap 
-                horizontalMetaBlockCount verticalMetaBlockCount
-                blockDecoder
-
-            finalizeBoolWriter writeState
-

@@ -1,232 +0,0 @@-{-# LANGUAGE BangPatterns #-}
-module Codec.Picture.Jpg.Common
-    ( DctCoefficients
-    , JpgUnpackerParameter( .. )
-    , decodeInt
-    , dcCoefficientDecode
-    , deQuantize
-    , decodeRrrrSsss
-    , zigZagReorderForward 
-    , zigZagReorderForwardv
-    , zigZagReorder
-    , inverseDirectCosineTransform
-    , unpackInt
-    , unpackMacroBlock
-    , rasterMap
-    , decodeMacroBlock
-    , decodeRestartInterval
-    ) where
-
-import Control.Applicative( (<$>), pure )
-import Control.Monad( replicateM, when )
-import Control.Monad.ST( ST, runST )
-import Data.Bits( unsafeShiftL, unsafeShiftR, (.&.) )
-import Data.Int( Int16, Int32 )
-import Data.List( foldl' )
-import Data.Maybe( fromMaybe )
-import Data.Word( Word8 )
-import qualified Data.Vector.Storable as VS
-import qualified Data.Vector.Storable.Mutable as M
-import Foreign.Storable ( Storable )
-
-import Codec.Picture.Types
-import Codec.Picture.BitWriter
-import Codec.Picture.Jpg.Types
-import Codec.Picture.Jpg.FastIdct
-import Codec.Picture.Jpg.DefaultTable
-
--- | Same as for DcCoefficient, to provide nicer type signatures
-type DctCoefficients = DcCoefficient
-
-data JpgUnpackerParameter = JpgUnpackerParameter
-    { dcHuffmanTree        :: !HuffmanPackedTree
-    , acHuffmanTree        :: !HuffmanPackedTree
-    , componentIndex       :: {-# UNPACK #-} !Int
-    , restartInterval      :: {-# UNPACK #-} !Int
-    , componentWidth       :: {-# UNPACK #-} !Int
-    , componentHeight      :: {-# UNPACK #-} !Int
-    , subSampling          :: !(Int, Int)
-    , coefficientRange     :: !(Int, Int)
-    , successiveApprox     :: !(Int, Int)
-    , readerIndex          :: {-# UNPACK #-} !Int
-    , indiceVector         :: {-# UNPACK #-} !Int
-    , blockIndex           :: {-# UNPACK #-} !Int
-    , blockMcuX            :: {-# UNPACK #-} !Int
-    , blockMcuY            :: {-# UNPACK #-} !Int
-    }
-    deriving Show
-
-decodeRestartInterval :: BoolReader s Int32
-decodeRestartInterval = return (-1) {-  do
-  bits <- replicateM 8 getNextBitJpg
-  if bits == replicate 8 True
-     then do
-         marker <- replicateM 8 getNextBitJpg
-         return $ packInt marker
-     else return (-1)
-        -}
-
-{-# INLINE decodeInt #-}
-decodeInt :: Int -> BoolReader s Int32
-decodeInt ssss = do
-    signBit <- getNextBitJpg
-    let dataRange = 1 `unsafeShiftL` fromIntegral (ssss - 1)
-        leftBitCount = ssss - 1
-    -- First following bits store the sign of the coefficient, and counted in
-    -- SSSS, so the bit count for the int, is ssss - 1
-    if signBit
-       then (\w -> dataRange + fromIntegral w) <$> unpackInt leftBitCount
-       else (\w -> 1 - dataRange * 2 + fromIntegral w) <$> unpackInt leftBitCount
-
-decodeRrrrSsss :: HuffmanPackedTree -> BoolReader s (Int, Int)
-decodeRrrrSsss tree = do
-    rrrrssss <- huffmanPackedDecode tree
-    let rrrr = (rrrrssss `unsafeShiftR` 4) .&. 0xF
-        ssss =  rrrrssss .&. 0xF
-    pure (fromIntegral rrrr, fromIntegral ssss)
-
-dcCoefficientDecode :: HuffmanPackedTree -> BoolReader s DcCoefficient
-dcCoefficientDecode dcTree = do
-    ssss <- huffmanPackedDecode dcTree
-    if ssss == 0
-       then return 0
-       else fromIntegral <$> decodeInt (fromIntegral ssss)
-
--- | Apply a quantization matrix to a macroblock
-{-# INLINE deQuantize #-}
-deQuantize :: MacroBlock Int16 -> MutableMacroBlock s Int16
-           -> ST s (MutableMacroBlock s Int16)
-deQuantize table block = update 0
-    where update 64 = return block
-          update i = do
-              val <- block `M.unsafeRead` i
-              let finalValue = val * (table `VS.unsafeIndex` i)
-              (block `M.unsafeWrite` i) finalValue
-              update $ i + 1
-
-inverseDirectCosineTransform :: MutableMacroBlock s Int16
-                             -> ST s (MutableMacroBlock s Int16)
-inverseDirectCosineTransform mBlock =
-    fastIdct mBlock >>= mutableLevelShift
-
-zigZagOrder :: MacroBlock Int
-zigZagOrder = makeMacroBlock $ concat
-    [[ 0, 1, 5, 6,14,15,27,28]
-    ,[ 2, 4, 7,13,16,26,29,42]
-    ,[ 3, 8,12,17,25,30,41,43]
-    ,[ 9,11,18,24,31,40,44,53]
-    ,[10,19,23,32,39,45,52,54]
-    ,[20,22,33,38,46,51,55,60]
-    ,[21,34,37,47,50,56,59,61]
-    ,[35,36,48,49,57,58,62,63]
-    ]
-
-zigZagReorderForwardv :: (Storable a, Num a) => VS.Vector a -> VS.Vector a
-zigZagReorderForwardv vec = runST $ do
-    v <- M.new 64
-    mv <- VS.thaw vec
-    zigZagReorderForward v mv >>= VS.freeze
-
-zigZagOrderForward :: MacroBlock Int
-zigZagOrderForward = VS.generate 64 inv
-  where inv i = fromMaybe 0 $ VS.findIndex (i ==) zigZagOrder
-
-zigZagReorderForward :: (Storable a, Num a)
-                     => MutableMacroBlock s a
-                     -> MutableMacroBlock s a
-                     -> ST s (MutableMacroBlock s a)
-{-# SPECIALIZE INLINE zigZagReorderForward :: MutableMacroBlock s Int32
-                                           -> MutableMacroBlock s Int32
-                                           -> ST s (MutableMacroBlock s Int32) #-}
-{-# SPECIALIZE INLINE zigZagReorderForward :: MutableMacroBlock s Int16
-                                           -> MutableMacroBlock s Int16
-                                           -> ST s (MutableMacroBlock s Int16) #-}
-{-# SPECIALIZE INLINE zigZagReorderForward :: MutableMacroBlock s Word8
-                                           -> MutableMacroBlock s Word8
-                                           -> ST s (MutableMacroBlock s Word8) #-}
-zigZagReorderForward zigzaged block = ordering zigZagOrderForward >> return zigzaged
-  where ordering !table = reorder (0 :: Int)
-          where reorder !i | i >= 64 = return ()
-                reorder i  = do
-                     let idx = table `VS.unsafeIndex` i
-                     v <- block `M.unsafeRead` idx
-                     (zigzaged `M.unsafeWrite` i) v
-                     reorder (i + 1)
-
-zigZagReorder :: MutableMacroBlock s Int16 -> MutableMacroBlock s Int16
-              -> ST s (MutableMacroBlock s Int16)
-zigZagReorder zigzaged block = do
-    let update i =  do
-            let idx = zigZagOrder `VS.unsafeIndex` i
-            v <- block `M.unsafeRead` idx
-            (zigzaged `M.unsafeWrite` i) v
-
-        reorder 63 = update 63
-        reorder i  = update i >> reorder (i + 1)
-
-    reorder (0 :: Int)
-    return zigzaged
-
--- | Unpack an int of the given size encoded from MSB to LSB.
-unpackInt :: Int -> BoolReader s Int32
-unpackInt bitCount = packInt <$> replicateM bitCount getNextBitJpg
-
-
-{-# INLINE rasterMap #-}
-rasterMap :: (Monad m)
-          => Int -> Int -> (Int -> Int -> m ())
-          -> m ()
-rasterMap width height f = liner 0
-  where liner y | y >= height = return ()
-        liner y = columner 0
-          where columner x | x >= width = liner (y + 1)
-                columner x = f x y >> columner (x + 1)
-
-packInt :: [Bool] -> Int32
-packInt = foldl' bitStep 0
-    where bitStep acc True = (acc `unsafeShiftL` 1) + 1
-          bitStep acc False = acc `unsafeShiftL` 1
-
-pixelClamp :: Int16 -> Word8
-pixelClamp n = fromIntegral . min 255 $ max 0 n
-
--- | Given a size coefficient (how much a pixel span horizontally
--- and vertically), the position of the macroblock, return a list
--- of indices and value to be stored in an array (like the final
--- image)
-unpackMacroBlock :: Int    -- ^ Component count
-                 -> Int -- ^ Width coefficient
-                 -> Int -- ^ Height coefficient
-                 -> Int -- ^ x
-                 -> Int -- ^ y
-                 -> Int    -- ^ Component index
-                 -> MutableImage s PixelYCbCr8
-                 -> MutableMacroBlock s Int16
-                 -> ST s ()
-unpackMacroBlock compCount wCoeff hCoeff compIdx x y
-                 (MutableImage { mutableImageWidth = imgWidth,
-                                 mutableImageHeight = imgHeight, mutableImageData = img })
-                 block = rasterMap dctBlockSize dctBlockSize unpacker
-  where unpacker i j = do
-          let yBase = y * dctBlockSize + j * hCoeff
-          compVal <- pixelClamp <$> (block `M.unsafeRead` (i + j * dctBlockSize))
-          rasterMap wCoeff hCoeff $ \wDup hDup -> do
-             let xBase = x * dctBlockSize + i * wCoeff
-                 xPos = xBase + wDup
-                 yPos = yBase + hDup
-
-             when (xPos < imgWidth && yPos < imgHeight)
-                  (do let mutableIdx = (xPos + yPos * imgWidth) * compCount + compIdx
-                      (img `M.unsafeWrite` mutableIdx) compVal)
-
--- | This is one of the most important function of the decoding,
--- it form the barebone decoding pipeline for macroblock. It's all
--- there is to know for macro block transformation
-decodeMacroBlock :: MacroBlock DctCoefficients
-                 -> MutableMacroBlock s Int16
-                 -> MutableMacroBlock s Int16
-                 -> ST s (MutableMacroBlock s Int16)
-decodeMacroBlock quantizationTable zigZagBlock block =
-    deQuantize quantizationTable block >>= zigZagReorder zigZagBlock
-                                       >>= inverseDirectCosineTransform
-

@@ -1,294 +0,0 @@-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE FlexibleContexts #-}
--- | Module used by the jpeg decoder internally, shouldn't be used
--- in user code.
-module Codec.Picture.Jpg.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 (Eq, Show)
-
-type HuffmanPackedTree = SV.Vector Word16
-
-type HuffmanWriterCode = V.Vector (Word8, Word16)
-
-packHuffmanTree :: HuffmanTree -> HuffmanPackedTree
-packHuffmanTree tree = runST $ do
-    table <- M.replicate 512 0x8000
-    let aux (Empty) idx = return $ idx + 1
-        aux (Leaf v) idx = do
-            (table `M.unsafeWrite` idx) $ (fromIntegral v .|. 0x4000)
-            return $ idx + 1
-
-        aux (Branch i1@(Leaf _) i2@(Leaf _)) idx =
-            aux i1 idx >>= aux i2
-
-        aux (Branch i1@(Leaf _) i2) idx = do
-            _ <- aux i1 idx
-            ix2 <- aux i2 $ idx + 2
-            (table `M.unsafeWrite` (idx + 1)) $ fromIntegral $ idx + 2
-            return ix2
-
-        aux (Branch i1 i2@(Leaf _)) idx = do
-            ix1 <- aux i1 (idx + 2)
-            _ <- aux i2 (idx + 1)
-            (table `M.unsafeWrite` idx) . fromIntegral $ idx + 2
-            return ix1
-
-        aux (Branch i1 i2) idx = do
-            ix1 <- aux i1 (idx + 2)
-            ix2 <- aux i2 ix1
-            (table `M.unsafeWrite` idx) (fromIntegral $ idx + 2)
-            (table `M.unsafeWrite` (idx + 1)) (fromIntegral ix1)
-            return ix2
-    _ <- aux tree 0
-    SV.unsafeFreeze table
-
-makeInverseTable :: HuffmanTree -> HuffmanWriterCode
-makeInverseTable t = V.replicate 255 (0,0) V.// inner 0 0 t
-  where inner _     _     Empty   = []
-        inner depth code (Leaf v) = [(fromIntegral v, (depth, code))]
-        inner depth code (Branch l r) =
-          inner (depth + 1) shifted l ++ inner (depth + 1) (shifted .|. 1) r
-            where shifted = code `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 = SV.fromListN 64
-
--- | Enumeration used to search in the tables for different components.
-data DctComponent = DcComponent | AcComponent
-    deriving (Eq, Show)
-
--- | Transform parsed coefficients from the jpeg header to a
--- tree which can be used to decode data.
-buildHuffmanTree :: [[Word8]] -> HuffmanTree
-buildHuffmanTree table = foldl' insertHuffmanVal Empty
-                       . concatMap (\(i, t) -> map (i + 1,) t)
-                       $ zip ([0..] :: [Int]) table
-  where isTreeFullyDefined Empty = False
-        isTreeFullyDefined (Leaf _) = True
-        isTreeFullyDefined (Branch l r) = isTreeFullyDefined l && isTreeFullyDefined r
-
-        insertHuffmanVal Empty (0, val) = Leaf val
-        insertHuffmanVal Empty (d, val) = Branch (insertHuffmanVal Empty (d - 1, val)) Empty
-        insertHuffmanVal (Branch l r) (d, val)
-            | isTreeFullyDefined l = Branch l (insertHuffmanVal r (d - 1, val))
-            | otherwise            = Branch (insertHuffmanVal l (d - 1, val)) r
-        insertHuffmanVal (Leaf _) _ = error "Inserting in value, shouldn't happen"
-
-scaleQuantisationMatrix :: Int -> QuantificationTable -> QuantificationTable 
-scaleQuantisationMatrix quality
-    | quality < 0 = scaleQuantisationMatrix 0
-        -- shouldn't show much difference than with 1,
-        -- but hey, at least we're complete
-    | quality == 0 = SV.map (scale (10000 :: Int))
-    | quality < 50 = let qq = 5000 `div` quality
-                     in SV.map (scale qq)
-    | otherwise    = SV.map (scale q)
-          where q = 200 - quality * 2
-                scale coeff i = fromIntegral . min 255 
-                                             . max 1 
-                                             $ fromIntegral i * coeff `div` 100
-
-huffmanPackedDecode :: HuffmanPackedTree -> BoolReader s Word8
-huffmanPackedDecode table = getNextBitJpg >>= aux 0
-  where aux idx b
-            | (v .&. 0x8000) /= 0 = return  0
-            | (v .&. 0x4000) /= 0 = return . fromIntegral $ v .&. 0xFF
-            | otherwise = getNextBitJpg >>= aux v
-          where tableIndex | b = idx + 1
-                           | otherwise = idx
-                v = table `SV.unsafeIndex` fromIntegral tableIndex
-
-defaultLumaQuantizationTable :: QuantificationTable
-defaultLumaQuantizationTable = 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 = 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 = buildHuffmanTree defaultDcLumaHuffmanTable
-
--- | From the Table K.3 of ITU-81 (p153)
-defaultDcLumaHuffmanTable :: HuffmanTable
-defaultDcLumaHuffmanTable =
-    [ []
-    , [0]
-    , [1, 2, 3, 4, 5]
-    , [6]
-    , [7]
-    , [8]
-    , [9]
-    , [10]
-    , [11]
-    , []
-    , []
-    , []
-    , []
-    , []
-    , []
-    , []
-    ]
-
-defaultDcChromaHuffmanTree :: HuffmanTree
-defaultDcChromaHuffmanTree = buildHuffmanTree defaultDcChromaHuffmanTable
-
--- | From the Table K.4 of ITU-81 (p153)
-defaultDcChromaHuffmanTable :: HuffmanTable
-defaultDcChromaHuffmanTable = 
-    [ []
-    , [0, 1, 2]
-    , [3]
-    , [4]
-    , [5]
-    , [6]
-    , [7]
-    , [8]
-    , [9]
-    , [10]
-    , [11]
-    , []
-    , []
-    , []
-    , []
-    , []
-    ]
-
-defaultAcLumaHuffmanTree :: HuffmanTree
-defaultAcLumaHuffmanTree = buildHuffmanTree defaultAcLumaHuffmanTable
-
--- | From the Table K.5 of ITU-81 (p154)
-defaultAcLumaHuffmanTable :: HuffmanTable
-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 = buildHuffmanTree defaultAcChromaHuffmanTable 
-
-defaultAcChromaHuffmanTable :: HuffmanTable
-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
-      ]
-    ]
-

@@ -1,203 +0,0 @@-module Codec.Picture.Jpg.FastDct( referenceDct, fastDctLibJpeg ) where
-
-import Control.Applicative( (<$>) )
-import Data.Int( Int16, Int32 )
-import Data.Bits( Bits, unsafeShiftR, unsafeShiftL )
-import Control.Monad.ST( ST )
-
-import qualified Data.Vector.Storable.Mutable as M
-
-import Codec.Picture.Jpg.Types
-import Control.Monad( forM, forM_ )
-
--- | Reference implementation of the DCT, directly implementing the formula
--- of ITU-81. It's slow as hell, perform to many operations, but is accurate
--- and a good reference point.
-referenceDct :: MutableMacroBlock s Int32
-             -> MutableMacroBlock s Int16
-             -> ST s (MutableMacroBlock s Int32)
-referenceDct workData block = forM_ [(u, v) | u <- [0 :: Int .. dctBlockSize - 1], v <- [0..dctBlockSize - 1]] (\(u,v) -> do
-    val <- at (u,v)
-    (workData `M.unsafeWrite` (v * dctBlockSize + u)) . truncate $ (1 / 4) * c u * c v * val)
-    >> return workData
- where -- at :: (Int, Int) -> ST s Float
-       at (u,v) = sum <$> (forM [(x,y) | x <- [0..dctBlockSize - 1], y <- [0..dctBlockSize - 1 :: Int]] $ \(x,y) -> do
-           sample <- fromIntegral <$> (block `M.unsafeRead` (y * dctBlockSize + x))
-           return $ sample * cos ((2 * fromIntegral x + 1) * fromIntegral u * (pi :: Float)/ 16) 
-                           * cos ((2 * fromIntegral y + 1) * fromIntegral v * pi / 16))
-       c 0 = 1 / sqrt 2
-       c _ = 1
-
-pASS1_BITS, cONST_BITS :: Int
-cONST_BITS = 13
-pASS1_BITS =  2
-
-
-fIX_0_298631336, fIX_0_390180644, fIX_0_541196100,
-    fIX_0_765366865, fIX_0_899976223, fIX_1_175875602,
-    fIX_1_501321110, fIX_1_847759065, fIX_1_961570560,
-    fIX_2_053119869, fIX_2_562915447, fIX_3_072711026 :: Int32
-fIX_0_298631336 =(2446)    -- FIX(0.298631336) */
-fIX_0_390180644 =(3196)    -- FIX(0.390180644) */
-fIX_0_541196100 =(4433)    -- FIX(0.541196100) */
-fIX_0_765366865 =(6270)    -- FIX(0.765366865) */
-fIX_0_899976223 =(7373)    -- FIX(0.899976223) */
-fIX_1_175875602 =(9633)    -- FIX(1.175875602) */
-fIX_1_501321110 =(12299)    -- FIX(1.501321110) */
-fIX_1_847759065 =(15137)    -- FIX(1.847759065) */
-fIX_1_961570560 =(16069)    -- FIX(1.961570560) */
-fIX_2_053119869 =(16819)    -- FIX(2.053119869) */
-fIX_2_562915447 =(20995)    -- FIX(2.562915447) */
-fIX_3_072711026 =(25172)    -- FIX(3.072711026) */
-
-cENTERJSAMPLE :: Int32
-cENTERJSAMPLE = 128
-
--- | Fast DCT extracted from libjpeg
-fastDctLibJpeg :: MutableMacroBlock s Int32
-        -> MutableMacroBlock s Int16
-        -> ST s (MutableMacroBlock s Int32)
-fastDctLibJpeg workData sample_block = do
- firstPass workData  0
- secondPass workData 7
- {-_ <- mutate (\_ a -> a `quot` 8) workData-}
- return workData
-  where -- Pass 1: process rows.
-        -- Note results are scaled up by sqrt(8) compared to a true DCT;
-        -- furthermore, we scale the results by 2**PASS1_BITS.
-        firstPass         _ i | i == dctBlockSize = return ()
-        firstPass dataBlock i = do
-            let baseIdx = i * dctBlockSize
-                readAt idx = fromIntegral <$> sample_block `M.unsafeRead` (baseIdx + idx)
-                mult = (*)
-                writeAt idx n = (dataBlock `M.unsafeWrite` (baseIdx + idx)) n
-                writeAtPos idx n = (dataBlock `M.unsafeWrite` (baseIdx + idx))
-                                    (n `unsafeShiftR` (cONST_BITS - pASS1_BITS))
-
-            blk0 <- readAt 0
-            blk1 <- readAt 1
-            blk2 <- readAt 2
-            blk3 <- readAt 3
-            blk4 <- readAt 4
-            blk5 <- readAt 5
-            blk6 <- readAt 6
-            blk7 <- readAt 7
-
-            let tmp0 = blk0 + blk7
-                tmp1 = blk1 + blk6
-                tmp2 = blk2 + blk5
-                tmp3 = blk3 + blk4
-
-                tmp10 = tmp0 + tmp3
-                tmp12 = tmp0 - tmp3
-                tmp11 = tmp1 + tmp2
-                tmp13 = tmp1 - tmp2
-
-                tmp0' = blk0 - blk7
-                tmp1' = blk1 - blk6
-                tmp2' = blk2 - blk5
-                tmp3' = blk3 - blk4
-
-            -- Stage 4 and output
-            writeAt 0 $ (tmp10 + tmp11 - dctBlockSize * cENTERJSAMPLE) `unsafeShiftL` pASS1_BITS
-            writeAt 4 $ (tmp10 - tmp11) `unsafeShiftL` pASS1_BITS
-
-            let z1 = mult (tmp12 + tmp13) fIX_0_541196100
-                     + (1 `unsafeShiftL` (cONST_BITS - pASS1_BITS - 1))
-
-            writeAtPos 2 $ z1 + mult tmp12 fIX_0_765366865
-            writeAtPos 6 $ z1 - mult tmp13 fIX_1_847759065
-
-            let tmp10' = tmp0' + tmp3'
-                tmp11' = tmp1' + tmp2'
-                tmp12' = tmp0' + tmp2'
-                tmp13' = tmp1' + tmp3'
-                z1' = mult (tmp12' + tmp13') fIX_1_175875602 --  c3 */
-                        -- Add fudge factor here for final descale. */
-                        + (1 `unsafeShiftL` (cONST_BITS - pASS1_BITS-1))
-                tmp0'' = mult tmp0' fIX_1_501321110
-                tmp1'' = mult tmp1' fIX_3_072711026
-                tmp2'' = mult tmp2' fIX_2_053119869
-                tmp3'' = mult tmp3' fIX_0_298631336
-
-                tmp10'' = mult tmp10' (- fIX_0_899976223)
-                tmp11'' = mult tmp11' (- fIX_2_562915447)
-                tmp12'' = mult tmp12' (- fIX_0_390180644) + z1'
-                tmp13'' = mult tmp13' (- fIX_1_961570560) + z1'
-
-            writeAtPos 1 $ tmp0'' + tmp10'' + tmp12''
-            writeAtPos 3 $ tmp1'' + tmp11'' + tmp13''
-            writeAtPos 5 $ tmp2'' + tmp11'' + tmp12''
-            writeAtPos 7 $ tmp3'' + tmp10'' + tmp13''
-
-            firstPass dataBlock $ i + 1
-
-        -- Pass 2: process columns.
-        -- We remove the PASS1_BITS scaling, but leave the results scaled up
-        -- by an overall factor of 8.
-        secondPass :: M.STVector s Int32 -> Int -> ST s ()
-        secondPass _     (-1) = return ()
-        secondPass block i = do
-            let readAt idx = block `M.unsafeRead` ((7 - i) + idx * dctBlockSize)
-                mult = (*)
-                writeAt idx n = (block `M.unsafeWrite` (dctBlockSize * idx + (7 - i))) n
-                writeAtPos idx n = (block `M.unsafeWrite` (dctBlockSize * idx + (7 - i))) $ n `unsafeShiftR` (cONST_BITS + pASS1_BITS + 3)
-            blk0 <- readAt 0
-            blk1 <- readAt 1
-            blk2 <- readAt 2
-            blk3 <- readAt 3
-            blk4 <- readAt 4
-            blk5 <- readAt 5
-            blk6 <- readAt 6
-            blk7 <- readAt 7
-
-            let tmp0 = blk0 + blk7
-                tmp1 = blk1 + blk6
-                tmp2 = blk2 + blk5
-                tmp3 = blk3 + blk4
-
-                -- Add fudge factor here for final descale. */
-                tmp10 = tmp0 + tmp3 + (1 `unsafeShiftL` (pASS1_BITS-1))
-                tmp12 = tmp0 - tmp3
-                tmp11 = tmp1 + tmp2
-                tmp13 = tmp1 - tmp2
-
-                tmp0' = blk0 - blk7
-                tmp1' = blk1 - blk6
-                tmp2' = blk2 - blk5
-                tmp3' = blk3 - blk4
-
-            writeAt 0 $ (tmp10 + tmp11) `unsafeShiftR` (pASS1_BITS + 3)
-            writeAt 4 $ (tmp10 - tmp11) `unsafeShiftR` (pASS1_BITS + 3)
-
-            let z1 = mult (tmp12 + tmp13) fIX_0_541196100
-                    + (1 `unsafeShiftL` (cONST_BITS + pASS1_BITS - 1))
-
-            writeAtPos 2 $ z1 + mult tmp12 fIX_0_765366865
-            writeAtPos 6 $ z1 - mult tmp13 fIX_1_847759065
-
-            let tmp10' = tmp0' + tmp3'
-                tmp11' = tmp1' + tmp2'
-                tmp12' = tmp0' + tmp2'
-                tmp13' = tmp1' + tmp3'
-
-                z1' = mult (tmp12' + tmp13') fIX_1_175875602
-                    -- Add fudge factor here for final descale. */
-                   + 1 `unsafeShiftL` (cONST_BITS+pASS1_BITS-1);
-
-                tmp0''  = mult tmp0'    fIX_1_501321110
-                tmp1''  = mult tmp1'    fIX_3_072711026
-                tmp2''  = mult tmp2'    fIX_2_053119869
-                tmp3''  = mult tmp3'    fIX_0_298631336
-                tmp10'' = mult tmp10' (- fIX_0_899976223)
-                tmp11'' = mult tmp11' (- fIX_2_562915447)
-                tmp12'' = mult tmp12' (- fIX_0_390180644)
-                            + z1'
-                tmp13'' = mult tmp13' (- fIX_1_961570560)
-                            + z1'
-            writeAtPos 1 $ tmp0'' + tmp10'' + tmp12''
-            writeAtPos 3 $ tmp1'' + tmp11'' + tmp13''
-            writeAtPos 5 $ tmp2'' + tmp11'' + tmp12''
-            writeAtPos 7 $ tmp3'' + tmp10'' + tmp13''
-
-            secondPass block (i - 1)

@@ -1,228 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}
--- | Module providing a 'fast' implementation of IDCT
---
--- inverse two dimensional DCT, Chen-Wang algorithm       
--- (cf. IEEE ASSP-32, pp. 803-816, Aug. 1984)             
--- 32-bit integer arithmetic (8 bit coefficients)         
--- 11 mults, 29 adds per DCT                              
---                                      sE, 18.8.91       
---
--- coefficients extended to 12 bit for IEEE1180-1990      
--- compliance                           sE,  2.1.94       
---
--- this code assumes >> to be a two's-complement arithmetic
--- right shift: (-2)>>1 == -1 , (-3)>>1 == -2               
-module Codec.Picture.Jpg.FastIdct( MutableMacroBlock
-                                 , fastIdct
-                                 , mutableLevelShift
-                                 , createEmptyMutableMacroBlock
-                                 ) where
-
-import qualified Data.Vector.Storable as V
-import Control.Monad.ST( ST )
-import Data.Bits( unsafeShiftL, unsafeShiftR )
-import Data.Int( Int16 )
-import qualified Data.Vector.Storable.Mutable as M
-
-import Codec.Picture.Jpg.Types
-
-iclip :: V.Vector Int16
-iclip = V.fromListN 1024 [ val i| i <- [(-512) .. 511] ]
-    where val i | i < (-256) = -256
-                | i > 255    =  255
-                | otherwise  =  i
-
-data IDctStage = IDctStage { 
-        x0 :: {-# UNPACK #-} !Int,
-        x1 :: {-# UNPACK #-} !Int,
-        x2 :: {-# UNPACK #-} !Int,
-        x3 :: {-# UNPACK #-} !Int,
-        x4 :: {-# UNPACK #-} !Int,
-        x5 :: {-# UNPACK #-} !Int,
-        x6 :: {-# UNPACK #-} !Int,
-        x7 :: {-# UNPACK #-} !Int,
-        x8 :: {-# UNPACK #-} !Int
-    }
-
-w1, w2, w3, w5, w6, w7 :: Int
-w1 = 2841 -- 2048*sqrt(2)*cos(1*pi/16)
-w2 = 2676 -- 2048*sqrt(2)*cos(2*pi/16)
-w3 = 2408 -- 2048*sqrt(2)*cos(3*pi/16)
-w5 = 1609 -- 2048*sqrt(2)*cos(5*pi/16)
-w6 = 1108 -- 2048*sqrt(2)*cos(6*pi/16)
-w7 = 565  -- 2048*sqrt(2)*cos(7*pi/16)
-
--- row (horizontal) IDCT
---
---           7                       pi         1
--- dst[k] = sum c[l] * src[l] * cos( -- * ( k + - ) * l )
---          l=0                      8          2
---
--- where: c[0]    = 128
---        c[1..7] = 128*sqrt(2)
-idctRow :: MutableMacroBlock s Int16 -> Int ->  ST s ()
-idctRow blk idx = do
-  xx0 <- blk `M.unsafeRead` (0 + idx)
-  xx1 <- blk `M.unsafeRead` (4 + idx) 
-  xx2 <- blk `M.unsafeRead` (6 + idx)
-  xx3 <- blk `M.unsafeRead` (2 + idx)
-  xx4 <- blk `M.unsafeRead` (1 + idx)
-  xx5 <- blk `M.unsafeRead` (7 + idx)
-  xx6 <- blk `M.unsafeRead` (5 + idx)
-  xx7 <- blk `M.unsafeRead` (3 + idx)
-  let initialState = IDctStage { x0 = (fromIntegral xx0 `unsafeShiftL` 11) + 128
-                               , x1 =  fromIntegral xx1 `unsafeShiftL` 11
-                               , x2 =  fromIntegral xx2
-                               , x3 =  fromIntegral xx3
-                               , x4 =  fromIntegral xx4
-                               , x5 =  fromIntegral xx5
-                               , x6 =  fromIntegral xx6
-                               , x7 =  fromIntegral xx7
-                               , x8 = 0
-                               } 
-
-      firstStage c = c { x4 = x8'  + (w1 - w7) * x4 c
-                       , x5 = x8'  - (w1 + w7) * x5 c
-                       , x6 = x8'' - (w3 - w5) * x6 c
-                       , x7 = x8'' - (w3 + w5) * x7 c
-                       , x8 = x8''
-                       }
-          where x8' = w7 * (x4 c + x5 c)
-                x8'' = w3 * (x6 c + x7 c)
-
-      secondStage c = c { x0 = x0 c - x1 c
-                        , x8 = x0 c + x1 c 
-                        , x1 = x1''
-                        , x2 = x1' - (w2 + w6) * x2 c
-                        , x3 = x1' + (w2 - w6) * x3 c
-                        , x4 = x4 c - x6 c
-                        , x6 = x5 c + x7 c
-                        , x5 = x5 c - x7 c
-                        }
-            where x1'  = w6 * (x3 c + x2 c)
-                  x1'' = x4 c + x6 c
-
-      thirdStage c = c { x7 = x8 c + x3 c
-                       , x8 = x8 c - x3 c
-                       , x3 = x0 c + x2 c
-                       , x0 = x0 c - x2 c
-                       , x2 = (181 * (x4 c + x5 c) + 128) `unsafeShiftR` 8
-                       , x4 = (181 * (x4 c - x5 c) + 128) `unsafeShiftR` 8
-                       }
-      scaled c = c { x0 = (x7 c + x1 c) `unsafeShiftR` 8
-                   , x1 = (x3 c + x2 c) `unsafeShiftR` 8
-                   , x2 = (x0 c + x4 c) `unsafeShiftR` 8
-                   , x3 = (x8 c + x6 c) `unsafeShiftR` 8
-                   , x4 = (x8 c - x6 c) `unsafeShiftR` 8
-                   , x5 = (x0 c - x4 c) `unsafeShiftR` 8
-                   , x6 = (x3 c - x2 c) `unsafeShiftR` 8
-                   , x7 = (x7 c - x1 c) `unsafeShiftR` 8
-                   }
-      transformed = scaled . thirdStage . secondStage $ firstStage initialState
-
-  (blk `M.unsafeWrite` (0 + idx)) . fromIntegral $ x0 transformed
-  (blk `M.unsafeWrite` (1 + idx)) . fromIntegral $ x1 transformed
-  (blk `M.unsafeWrite` (2 + idx)) . fromIntegral $ x2 transformed
-  (blk `M.unsafeWrite` (3 + idx)) . fromIntegral $ x3 transformed
-  (blk `M.unsafeWrite` (4 + idx)) . fromIntegral $ x4 transformed
-  (blk `M.unsafeWrite` (5 + idx)) . fromIntegral $ x5 transformed
-  (blk `M.unsafeWrite` (6 + idx)) . fromIntegral $ x6 transformed
-  (blk `M.unsafeWrite` (7 + idx)) . fromIntegral $ x7 transformed
-
--- column (vertical) IDCT
---
---             7                         pi         1
--- dst[8*k] = sum c[l] * src[8*l] * cos( -- * ( k + - ) * l )
---            l=0                        8          2
---
--- where: c[0]    = 1/1024
---        c[1..7] = (1/1024)*sqrt(2)
---
-idctCol :: MutableMacroBlock s Int16 -> Int -> ST s ()
-idctCol blk idx = do
-  xx0 <- blk `M.unsafeRead` (    0 + idx)
-  xx1 <- blk `M.unsafeRead` (8 * 4 + idx)
-  xx2 <- blk `M.unsafeRead` (8 * 6 + idx)
-  xx3 <- blk `M.unsafeRead` (8 * 2 + idx)
-  xx4 <- blk `M.unsafeRead` (8     + idx)
-  xx5 <- blk `M.unsafeRead` (8 * 7 + idx)
-  xx6 <- blk `M.unsafeRead` (8 * 5 + idx)
-  xx7 <- blk `M.unsafeRead` (8 * 3 + idx)
-  let initialState = IDctStage { x0 = (fromIntegral xx0 `unsafeShiftL` 8) + 8192
-                               , x1 =  fromIntegral xx1 `unsafeShiftL` 8
-                               , x2 =  fromIntegral xx2
-                               , x3 =  fromIntegral xx3
-                               , x4 =  fromIntegral xx4
-                               , x5 =  fromIntegral xx5
-                               , x6 =  fromIntegral xx6
-                               , x7 =  fromIntegral xx7
-                               , x8 = 0
-                               } 
-      firstStage c = c { x4 = (x8'  + (w1 - w7) * x4 c) `unsafeShiftR` 3
-                       , x5 = (x8'  - (w1 + w7) * x5 c) `unsafeShiftR` 3
-                       , x6 = (x8'' - (w3 - w5) * x6 c) `unsafeShiftR` 3
-                       , x7 = (x8'' - (w3 + w5) * x7 c) `unsafeShiftR` 3
-                       , x8 = x8''
-                       }
-          where x8'  = w7 * (x4 c + x5 c) + 4
-                x8'' = w3 * (x6 c + x7 c) + 4
-
-      secondStage c = c { x8 = x0 c + x1 c
-                        , x0 = x0 c - x1 c
-                        , x2 = (x1' - (w2 + w6) * x2 c) `unsafeShiftR` 3
-                        , x3 = (x1' + (w2 - w6) * x3 c) `unsafeShiftR` 3
-                        , x4 = x4 c - x6 c
-                        , x1 = x1''
-                        , x6 = x5 c + x7 c
-                        , x5 = x5 c - x7 c
-                        }
-          where x1'  = w6 * (x3 c + x2 c) + 4
-                x1'' = x4 c + x6 c
-  
-      thirdStage c = c { x7 = x8 c + x3 c
-                       , x8 = x8 c - x3 c
-                       , x3 = x0 c + x2 c
-                       , x0 = x0 c - x2 c
-                       , x2 = (181 * (x4 c + x5 c) + 128) `unsafeShiftR` 8
-                       , x4 = (181 * (x4 c - x5 c) + 128) `unsafeShiftR` 8
-                       }
-
-      clip i | i < 511 = if i > -512 then iclip `V.unsafeIndex` (i + 512)
-                                    else iclip `V.unsafeIndex` 0
-            
-             | otherwise = iclip `V.unsafeIndex` 1023
-
-      f = thirdStage . secondStage $ firstStage initialState
-  (blk `M.unsafeWrite` (idx + 8*0)) . clip $ (x7 f + x1 f) `unsafeShiftR` 14
-  (blk `M.unsafeWrite` (idx + 8  )) . clip $ (x3 f + x2 f) `unsafeShiftR` 14
-  (blk `M.unsafeWrite` (idx + 8*2)) . clip $ (x0 f + x4 f) `unsafeShiftR` 14
-  (blk `M.unsafeWrite` (idx + 8*3)) . clip $ (x8 f + x6 f) `unsafeShiftR` 14
-  (blk `M.unsafeWrite` (idx + 8*4)) . clip $ (x8 f - x6 f) `unsafeShiftR` 14
-  (blk `M.unsafeWrite` (idx + 8*5)) . clip $ (x0 f - x4 f) `unsafeShiftR` 14
-  (blk `M.unsafeWrite` (idx + 8*6)) . clip $ (x3 f - x2 f) `unsafeShiftR` 14
-  (blk `M.unsafeWrite` (idx + 8*7)) . clip $ (x7 f - x1 f) `unsafeShiftR` 14
-
-
-{-# INLINE fastIdct #-}
--- | Algorithm to call to perform an IDCT, return the same
--- block that the one given as input.
-fastIdct :: MutableMacroBlock s Int16
-         -> ST s (MutableMacroBlock s Int16)
-fastIdct block = rows 0
-  where rows 8 = cols 0
-        rows i = idctRow block (8 * i) >> rows (i + 1)
-
-        cols 8 = return block
-        cols i = idctCol block i >> cols (i + 1)
-
-{-# INLINE mutableLevelShift #-}
--- | Perform a Jpeg level shift in a mutable fashion.
-mutableLevelShift :: MutableMacroBlock s Int16
-                  -> ST s (MutableMacroBlock s Int16)
-mutableLevelShift block = update 0
-  where update 64 = return block
-        update idx = do
-            val <- block `M.unsafeRead` idx
-            (block `M.unsafeWrite` idx) $ val + 128
-            update $ idx + 1
-

@@ -1,309 +0,0 @@-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE FlexibleInstances #-}
-module Codec.Picture.Jpg.Progressive
-    ( JpgUnpackerParameter( .. )
-    , progressiveUnpack
-    ) where
-
-import Control.Applicative( pure, (<$>), (<*>) )
-import Control.Monad( when, forM_ )
-import Control.Monad.ST( ST )
-import Control.Monad.Trans( lift )
-import Data.Bits( (.&.), (.|.), unsafeShiftL )
-import Data.Int( Int16, Int32 )
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Lazy as L
-import qualified Data.Vector as V
-import qualified Data.Vector.Storable as VS
-import Data.Vector( (!) )
-import qualified Data.Vector.Mutable as M
-import qualified Data.Vector.Storable.Mutable as MS
-
-import Codec.Picture.Types
-import Codec.Picture.BitWriter
-import Codec.Picture.Jpg.Common
-import Codec.Picture.Jpg.Types
-import Codec.Picture.Jpg.DefaultTable
-
-mcuIndexer :: JpgComponent -> DctComponent -> Int -> VS.Vector Int
-mcuIndexer param kind mcuWidth = VS.fromListN (mcuWidth * th) indexes
-  where compW = fromIntegral $ horizontalSamplingFactor param
-        compH = fromIntegral $ verticalSamplingFactor param
-        th = compW * compH
-
-        index AcComponent mcu y x = mcu * th + x + y * compW
-        index DcComponent mcu y x = (mcu + y * mcuWidth) * compW + x
-        indexes =
-            index kind <$> [0 .. mcuWidth - 1] <*> [0 .. compH - 1] <*> [0 .. compW - 1]
-
-createMcuLineIndices :: JpgComponent -> Int -> V.Vector (VS.Vector Int)
-createMcuLineIndices comp mcuWidth =
-  V.fromList [ mcuIndexer comp part mcuWidth | part <- [DcComponent, AcComponent] ]
-
-decodeFirstDC :: JpgUnpackerParameter
-              -> MS.STVector s Int16
-              -> MutableMacroBlock s Int16
-              -> Int32
-              -> BoolReader s Int32
-decodeFirstDC params dcCoeffs block eobrun = unpack >> pure eobrun
-  where unpack = do
-          (dcDeltaCoefficient) <- dcCoefficientDecode $ dcHuffmanTree params
-          previousDc <- lift $ dcCoeffs `MS.unsafeRead` componentIndex params
-          let neoDcCoefficient = previousDc + dcDeltaCoefficient
-              approxLow = fst $ successiveApprox params
-              scaledDc = neoDcCoefficient `unsafeShiftL` approxLow
-          lift $ (block `MS.unsafeWrite` 0) scaledDc 
-          lift $ (dcCoeffs `MS.unsafeWrite` componentIndex params) neoDcCoefficient
-
-decodeRefineDc :: JpgUnpackerParameter
-               -> a
-               -> MutableMacroBlock s Int16
-               -> Int32
-               -> BoolReader s Int32
-decodeRefineDc params _ block eobrun = unpack >> pure eobrun
-  where approxLow = fst $ successiveApprox params
-        plusOne = 1 `unsafeShiftL` approxLow
-        unpack = do
-            bit <- getNextBitJpg
-            when bit . lift $ do
-                v <- block `MS.unsafeRead` 0
-                (block `MS.unsafeWrite` 0) $ v .|. plusOne
-
-decodeFirstAc :: JpgUnpackerParameter
-              -> a
-              -> MutableMacroBlock s Int16
-              -> Int32
-              -> BoolReader s Int32
-decodeFirstAc _params _ _block eobrun | eobrun > 0 = pure $ eobrun - 1
-decodeFirstAc params _ block _ = unpack startIndex
-  where (startIndex, maxIndex) = coefficientRange params
-        (low, _) = successiveApprox params
-        unpack n | n > maxIndex = pure 0
-        unpack n = do
-            rrrrssss <- decodeRrrrSsss $ acHuffmanTree params
-            case rrrrssss of
-                (0xF, 0) -> unpack $ n + 16
-                (  0, 0) -> return 0
-                (  r, 0) -> eobrun <$> unpackInt r
-                    where eobrun lowBits = (1 `unsafeShiftL` r) - 1 + lowBits
-                (  r, s) -> do
-                    let n' = n + r
-                    val <- (`unsafeShiftL` low) <$> decodeInt s
-                    lift . (block `MS.unsafeWrite` n') $ fromIntegral val
-                    unpack $ n' + 1
-
-decodeRefineAc :: JpgUnpackerParameter
-               -> a
-               -> MutableMacroBlock s Int16
-               -> Int32
-               -> BoolReader s Int32
-decodeRefineAc params _ block eobrun
-        | eobrun == 0 = unpack startIndex
-        | otherwise   = performEobRun startIndex >> return (eobrun - 1)
-  where (startIndex, maxIndex) = coefficientRange params
-        (low, _) = successiveApprox params
-        plusOne = 1 `unsafeShiftL` low
-        minusOne = (-1) `unsafeShiftL` low
-
-        getBitVal = do
-            v <- getNextBitJpg
-            pure $ if v then plusOne else minusOne
-
-        {-performEobRun :: Int -> BoolReader s ()-}
-        performEobRun idx | idx > maxIndex = pure ()
-        performEobRun idx = do
-          coeff <- lift $ block `MS.unsafeRead` idx
-          when (coeff /= 0) $ do
-            bit <- getNextBitJpg
-            case (bit, (coeff .&. plusOne) == 0) of
-               (False, _)    -> performEobRun $ idx + 1
-               (True, False) -> performEobRun $ idx + 1
-               (True, True) -> do
-                   let newVal | coeff >= 0 = coeff + plusOne
-                              | otherwise = coeff + minusOne
-                   lift $ (block `MS.unsafeWrite` idx) newVal
-                   performEobRun $ idx + 1
-                   
-        unpack idx | idx > maxIndex = pure 0
-        unpack idx = do
-            rrrrssss <- decodeRrrrSsss $ acHuffmanTree params
-            case rrrrssss of
-              (0xF, 0) -> error "Dunno"
-              (  r, 0) -> do
-                  lowBits <- unpackInt r
-                  let newEobRun = (1 `unsafeShiftL` r) + lowBits - 1
-                  performEobRun idx
-                  pure newEobRun
-                         
-              (  r, _) -> do
-                  idx' <- updateCoeffs r idx
-                  val <- getBitVal
-                  when (idx <= maxIndex) $
-                       (lift $ (block `MS.unsafeWrite` idx') val)
-                  unpack $ idx' + 1
-
-        updateCoeffs r idx
-            | r   < 0        = pure idx
-            | idx > maxIndex = pure idx
-        updateCoeffs r idx = do
-          coeff <- lift $ block `MS.unsafeRead` idx
-          if coeff /= 0 then do
-            bit <- getNextBitJpg
-            when (bit && coeff .&. plusOne == 0) $
-                if coeff >= 0 then
-                    lift . (block `MS.unsafeWrite` idx) $ coeff + plusOne
-                else
-                    lift . (block `MS.unsafeWrite` idx) $ coeff + minusOne
-            updateCoeffs r $ idx + 1
-          else
-            updateCoeffs (r - 1) $ idx + 1
-
-type Unpacker s =
-    JpgUnpackerParameter -> MS.STVector s Int16 -> MutableMacroBlock s Int16 -> Int32
-        -> BoolReader s Int32
-
-
-prepareUnpacker :: [([(JpgUnpackerParameter, a)], L.ByteString)]
-                -> ST s ( V.Vector (V.Vector (JpgUnpackerParameter, Unpacker s))
-                        , M.STVector s BoolState)
-prepareUnpacker lst = do
-    let boolStates = V.fromList $ map snd infos
-    vec <- V.unsafeThaw boolStates
-    return (V.fromList $ map fst infos, vec)
-  where infos = map prepare lst
-        prepare ([], _) = error "progressiveUnpack, no component"
-        prepare (whole@((param, _) : _) , byteString) =
-         (V.fromList $ map (\(p,_) -> (p, unpacker)) whole, boolReader)
-           where unpacker = selection (successiveApprox param) (coefficientRange param)
-                 boolReader = initBoolStateJpg . B.concat $ L.toChunks byteString
-
-                 selection (_, 0) (0, _) = decodeFirstDC
-                 selection (_, 0) _      = decodeFirstAc
-                 selection _      (0, _) = decodeRefineDc
-                 selection _      _      = decodeRefineAc
-
-data ComponentData s = ComponentData
-    { componentIndices    :: V.Vector (VS.Vector Int)
-    , componentBlocks     :: V.Vector (MutableMacroBlock s Int16)
-    , componentId         :: !Int
-    , componentBlockCount :: !Int
-    }
-
--- | Iteration from to n in monadic context, without data
--- keeping.
-lineMap :: (Monad m) => Int -> (Int -> m ()) -> m ()
-{-# INLINE lineMap #-}
-lineMap count f = go 0
-  where go n | n >= count = return ()
-        go n = f n >> go (n + 1)
-
-progressiveUnpack :: (Int, Int)
-                  -> JpgFrameHeader
-                  -> V.Vector (MacroBlock Int16)
-                  -> [([(JpgUnpackerParameter, a)], L.ByteString)]
-                  -> ST s (MutableImage s PixelYCbCr8)
-progressiveUnpack (maxiW, maxiH) frame quants lst = do
-    (unpackers, readers) <- prepareUnpacker lst
-    allBlocks <- mapM allocateWorkingBlocks . zip [0..] $ jpgComponents frame
-                    :: ST s [ComponentData s]
-    let scanCount = length lst
-        restartIntervalValue = case lst of
-                ((p,_):_,_): _ -> restartInterval p
-                _ -> -1
-    dcCoeffs <- MS.replicate imgComponentCount 0
-    eobRuns <- MS.replicate (length lst) 0
-    workBlock <- createEmptyMutableMacroBlock
-    writeIndices <- MS.replicate imgComponentCount (0 :: Int)
-    restartIntervals <- MS.replicate scanCount restartIntervalValue
-    let elementCount = imgWidth * imgHeight * fromIntegral imgComponentCount
-    img <- MutableImage imgWidth imgHeight <$> MS.replicate elementCount 128
-
-    let processRestartInterval =
-          forM_ [0 .. scanCount - 1] $ \ix -> do
-            v <- restartIntervals `MS.read` ix
-            if v == 0 then do
-              -- reset DC prediction
-              when (ix == 0) (MS.set dcCoeffs 0)
-              reader <- readers `M.read` ix
-              (_, updated) <- runBoolReaderWith reader $
-                  byteAlignJpg >> decodeRestartInterval
-              (readers `M.write` ix) updated 
-              (eobRuns `MS.unsafeWrite` ix) 0
-              (restartIntervals `MS.unsafeWrite` ix) $ restartIntervalValue - 1
-            else
-              (restartIntervals `MS.unsafeWrite` ix) $ v - 1
-
-
-    lineMap imageMcuHeight $ \mmY -> do
-      -- Reset all blocks to 0
-      forM_ allBlocks $ V.mapM_ (flip MS.set 0) .  componentBlocks
-      MS.set writeIndices 0
-
-      lineMap imageMcuWidth $ \_mmx -> do
-        processRestartInterval 
-        V.forM_ unpackers $ V.mapM_ $ \(unpackParam, unpacker) -> do
-            boolState <- readers `M.read` readerIndex unpackParam
-            eobrun <- eobRuns `MS.read` readerIndex unpackParam
-            let componentNumber = componentIndex unpackParam
-            writeIndex <- writeIndices `MS.read` componentNumber
-            let componentData = allBlocks !! componentNumber
-                indexVector =
-                    componentIndices componentData ! indiceVector unpackParam
-                realIndex = indexVector VS.! (writeIndex + blockIndex unpackParam)
-                writeBlock = 
-                    componentBlocks componentData ! realIndex
-            (eobrun', state) <-
-                runBoolReaderWith boolState $
-                    unpacker unpackParam dcCoeffs writeBlock eobrun
-
-            (readers `M.write` readerIndex unpackParam) state
-            (eobRuns `MS.write` readerIndex unpackParam) eobrun'
-
-        -- Update the write indices
-        forM_ allBlocks $ \comp -> do
-          writeIndex <- writeIndices `MS.read` componentId comp
-          let newIndex = writeIndex + componentBlockCount comp
-          (writeIndices `MS.write` componentId comp) $ newIndex
-
-      forM_ allBlocks $ \compData -> do
-        let compBlocks = componentBlocks compData
-            cId = componentId compData
-            table = quants ! min 1 cId
-            comp = jpgComponents frame !! cId
-            compW = fromIntegral $ horizontalSamplingFactor comp
-            compH = fromIntegral $ verticalSamplingFactor comp
-            cw8 = maxiW - fromIntegral (horizontalSamplingFactor comp) + 1
-            ch8 = maxiH - fromIntegral (verticalSamplingFactor comp) + 1
-
-        rasterMap (imageMcuWidth * compW) compH $ \rx y -> do
-            let ry = mmY * maxiH + y
-                block = compBlocks ! (y * imageMcuWidth * compW + rx)
-            transformed <- decodeMacroBlock table workBlock block
-            unpackMacroBlock imgComponentCount
-                    cw8 ch8 cId (rx * cw8) ry
-                    img transformed
-
-    return img
-
-  where imgComponentCount = length $ jpgComponents frame
-        mcuBlockWidth = maxiW * dctBlockSize
-        mcuBlockHeight = maxiH * dctBlockSize
-
-        imgWidth = fromIntegral $ jpgWidth frame
-        imgHeight = fromIntegral $ jpgHeight frame
-        imageMcuWidth = (imgWidth + mcuBlockWidth - 1) `div` mcuBlockWidth
-        imageMcuHeight = (imgHeight + mcuBlockHeight - 1) `div` mcuBlockHeight 
-
-        allocateWorkingBlocks (ix, comp) = do
-            let blockCount = hSample * vSample * imageMcuWidth
-            blocks <- V.replicateM blockCount createEmptyMutableMacroBlock
-            return $ ComponentData 
-                { componentBlocks = blocks
-                , componentIndices = createMcuLineIndices comp imageMcuWidth
-                , componentBlockCount = hSample * vSample
-                , componentId = ix
-                }
-            where hSample = fromIntegral $ horizontalSamplingFactor comp
-                  vSample = fromIntegral $ verticalSamplingFactor comp
-

@@ -1,546 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}
-module Codec.Picture.Jpg.Types( MutableMacroBlock
-                              , createEmptyMutableMacroBlock
-                              , printMacroBlock
-                              , printPureMacroBlock
-                              , DcCoefficient
-                              , JpgImage( .. )
-                              , JpgComponent( .. )
-                              , JpgFrameHeader( .. )
-                              , JpgFrame( .. )
-                              , JpgFrameKind( .. )
-                              , JpgScanHeader( .. )
-                              , JpgQuantTableSpec( .. )
-                              , JpgHuffmanTableSpec( .. )
-                              , JpgImageKind( .. )
-                              , JpgScanSpecification( .. )
-                              , calculateSize
-                              , dctBlockSize
-                              ) where
-
-import Control.Applicative( (<$>), (<*>))
-import Control.Monad( when, replicateM, forM, forM_, unless )
-import Control.Monad.ST( ST )
-import Data.Bits( (.|.), (.&.), unsafeShiftL, unsafeShiftR )
-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.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
-                      )
-
-import Codec.Picture.InternalHelper
-import Codec.Picture.Jpg.DefaultTable
-
-{-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 (Eq, Show)
-
-data JpgFrame =
-      JpgAppFrame        !Word8 B.ByteString
-    | JpgExtension       !Word8 B.ByteString
-    | JpgQuantTable      ![JpgQuantTableSpec]
-    | JpgHuffmanTable    ![(JpgHuffmanTableSpec, HuffmanPackedTree)]
-    | JpgScanBlob        !JpgScanHeader !L.ByteString
-    | JpgScans           !JpgFrameKind !JpgFrameHeader
-    | JpgIntervalRestart !Word16
-    deriving Show
-
-data JpgFrameHeader = JpgFrameHeader
-    { jpgFrameHeaderLength   :: !Word16
-    , jpgSamplePrecision     :: !Word8
-    , jpgHeight              :: !Word16
-    , jpgWidth               :: !Word16
-    , jpgImageComponentCount :: !Word8
-    , jpgComponents          :: ![JpgComponent]
-    }
-    deriving Show
-
-
-instance SizeCalculable JpgFrameHeader where
-    calculateSize hdr = 2 + 1 + 2 + 2 + 1
-                      + sum [calculateSize c | c <- jpgComponents hdr]
-
-data JpgComponent = JpgComponent
-    { componentIdentifier       :: !Word8
-      -- | Stored with 4 bits
-    , horizontalSamplingFactor  :: !Word8
-      -- | Stored with 4 bits
-    , verticalSamplingFactor    :: !Word8
-    , quantizationTableDest     :: !Word8
-    }
-    deriving Show
-
-instance SizeCalculable JpgComponent where
-    calculateSize _ = 3
-
-data JpgImage = JpgImage { jpgFrame :: [JpgFrame] }
-    deriving Show
-
-data JpgScanSpecification = JpgScanSpecification
-    { componentSelector :: !Word8
-      -- | Encoded as 4 bits
-    , dcEntropyCodingTable :: !Word8
-      -- | Encoded as 4 bits
-    , acEntropyCodingTable :: !Word8
-
-    }
-    deriving Show
-
-instance SizeCalculable JpgScanSpecification where
-    calculateSize _ = 2
-
-data JpgScanHeader = JpgScanHeader
-    { scanLength :: !Word16
-    , scanComponentCount :: !Word8
-    , scans :: [JpgScanSpecification]
-
-      -- | (begin, end)
-    , spectralSelection    :: (Word8, Word8)
-
-      -- | Encoded as 4 bits
-    , successiveApproxHigh :: !Word8
-
-      -- | Encoded as 4 bits
-    , successiveApproxLow :: !Word8
-    }
-    deriving Show
-
-instance SizeCalculable JpgScanHeader where
-    calculateSize hdr = 2 + 1
-                      + sum [calculateSize c | c <- scans hdr]
-                      + 2
-                      + 1
-
-data JpgQuantTableSpec = JpgQuantTableSpec
-    { -- | Stored on 4 bits
-      quantPrecision     :: !Word8
-
-      -- | Stored on 4 bits
-    , quantDestination   :: !Word8
-
-    , quantTable         :: MacroBlock Int16
-    }
-    deriving 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 lst) = do
-        putWord16be . fromIntegral $ sum [calculateSize table | table <- lst] + 2
-        mapM_ put lst
-
-    get = TableList <$> (getWord16be >>= \s -> innerParse (fromIntegral s - 2))
-      where innerParse :: Int -> Get [a]
-            innerParse 0    = return []
-            innerParse size = do
-                onStart <- fromIntegral <$> bytesRead
-                table <- get
-                onEnd <- fromIntegral <$> bytesRead
-                (table :) <$> innerParse (size - (onEnd - onStart))
-
-instance SizeCalculable JpgQuantTableSpec where
-    calculateSize table =
-        1 + (fromIntegral (quantPrecision table) + 1) * 64
-
-instance Binary JpgQuantTableSpec where
-    put table = do
-        let precision = quantPrecision table
-        put4BitsOfEach precision (quantDestination table)
-        forM_ (VS.toList $ quantTable table) $ \coeff ->
-            if precision == 0 then putWord8 $ fromIntegral coeff
-                             else putWord16be $ fromIntegral coeff
-
-    get = do
-        (precision, dest) <- get4BitOfEach
-        coeffs <- replicateM 64 $ if precision == 0
-                then fromIntegral <$> getWord8
-                else fromIntegral <$> getWord16be
-        return JpgQuantTableSpec
-            { quantPrecision = precision
-            , quantDestination = dest
-            , quantTable = VS.fromListN 64 coeffs
-            }
-
-data JpgHuffmanTableSpec = JpgHuffmanTableSpec
-    { -- | 0 : DC, 1 : AC, stored on 4 bits
-      huffmanTableClass       :: !DctComponent
-      -- | Stored on 4 bits
-    , huffmanTableDest        :: !Word8
-
-    , huffSizes :: !(VU.Vector Word8)
-    , huffCodes :: !(V.Vector (VU.Vector Word8))
-    }
-    deriving Show
-
-instance SizeCalculable JpgHuffmanTableSpec where
-    calculateSize table = 1 + 16 + sum [fromIntegral e | e <- VU.toList $ huffSizes table]
-
-instance Binary JpgHuffmanTableSpec where
-    put table = do
-        let classVal = if huffmanTableClass table == DcComponent
-                          then 0 else 1
-        put4BitsOfEach classVal $ huffmanTableDest table
-        mapM_ put . VU.toList $ huffSizes table
-        forM_ [0 .. 15] $ \i ->
-            when (huffSizes table ! i /= 0)
-                 (let elements = VU.toList $ huffCodes table V.! i
-                  in mapM_ put elements)
-
-    get = do
-        (huffClass, huffDest) <- get4BitOfEach
-        sizes <- replicateM 16 getWord8
-        codes <- forM sizes $ \s ->
-            VU.replicateM (fromIntegral s) getWord8
-        return JpgHuffmanTableSpec
-            { huffmanTableClass =
-                if huffClass == 0 then DcComponent else AcComponent
-            , huffmanTableDest = huffDest
-            , huffSizes = VU.fromListN 16 sizes
-            , huffCodes = V.fromListN 16 codes
-            }
-
-instance Binary JpgImage where
-    put (JpgImage { jpgFrame = frames }) =
-        putWord8 0xFF >> putWord8 0xD8 >> mapM_ putFrame frames
-            >> putWord8 0xFF >> putWord8 0xD9
-
-    get = do
-        let startOfImageMarker = 0xD8
-            -- endOfImageMarker = 0xD9
-        checkMarker commonMarkerFirstByte startOfImageMarker
-        eatUntilCode
-        frames <- parseFrames
-        {-checkMarker commonMarkerFirstByte endOfImageMarker-}
-        return JpgImage { jpgFrame = frames }
-
-eatUntilCode :: Get ()
-eatUntilCode = do
-    code <- getWord8
-    unless (code == 0xFF) eatUntilCode
-
-takeCurrentFrame :: Get B.ByteString
-takeCurrentFrame = do
-    size <- getWord16be
-    getByteString (fromIntegral size - 2)
-
-putFrame :: JpgFrame -> Put
-putFrame (JpgAppFrame appCode str) =
-    put (JpgAppSegment appCode) >> putWord16be (fromIntegral $ B.length str) >> put str
-putFrame (JpgExtension appCode str) =
-    put (JpgExtensionSegment appCode) >> putWord16be (fromIntegral $ B.length str) >> put str
-putFrame (JpgQuantTable tables) =
-    put JpgQuantizationTable >> put (TableList tables)
-putFrame (JpgHuffmanTable tables) =
-    put JpgHuffmanTableMarker >> put (TableList $ map fst tables)
-putFrame (JpgIntervalRestart size) =
-    put JpgRestartInterval >> put (RestartInterval size)
-putFrame (JpgScanBlob hdr blob) =
-    put JpgStartOfScan >> put hdr >> putLazyByteString blob
-putFrame (JpgScans kind hdr) =
-    put kind >> put hdr
-
---------------------------------------------------
-----            Serialization instances
---------------------------------------------------
-commonMarkerFirstByte :: Word8
-commonMarkerFirstByte = 0xFF
-
-checkMarker :: Word8 -> Word8 -> Get ()
-checkMarker b1 b2 = do
-    rb1 <- getWord8
-    rb2 <- getWord8
-    when (rb1 /= b1 || rb2 /= b2)
-         (fail "Invalid marker used")
-
-extractScanContent :: L.ByteString -> (L.ByteString, L.ByteString)
-extractScanContent str = aux 0
-  where maxi = fromIntegral $ L.length str - 1
-
-        aux n | n >= maxi = (str, L.empty)
-              | v == 0xFF && vNext /= 0 && not isReset = L.splitAt n str
-              | otherwise = aux (n + 1)
-            where v = str `L.index` n
-                  vNext = str `L.index` (n + 1)
-                  isReset = 0xD0 <= vNext && vNext <= 0xD7
-
-parseFrames :: Get [JpgFrame]
-parseFrames = do
-    kind <- get
-    let parseNextFrame = do
-            word <- getWord8
-            when (word /= 0xFF) $ do
-                readedData <- bytesRead
-                fail $ "Invalid Frame marker (" ++ show word
-                     ++ ", bytes read : " ++ show readedData ++ ")"
-            parseFrames
-
-    case kind of
-        JpgEndOfImage -> return []
-        JpgAppSegment c ->
-            (\frm lst -> JpgAppFrame c frm : lst) <$> takeCurrentFrame <*> parseNextFrame
-        JpgExtensionSegment c ->
-            (\frm lst -> JpgExtension c frm : lst) <$> takeCurrentFrame <*> parseNextFrame
-        JpgQuantizationTable ->
-            (\(TableList quants) lst -> JpgQuantTable quants : lst) <$> get <*> parseNextFrame
-        JpgRestartInterval ->
-            (\(RestartInterval i) lst -> JpgIntervalRestart i : lst) <$> get <*> parseNextFrame
-        JpgHuffmanTableMarker ->
-            (\(TableList huffTables) lst ->
-                    JpgHuffmanTable [(t, packHuffmanTree . buildPackedHuffmanTree $ huffCodes t) | t <- huffTables] : lst)
-                    <$> get <*> parseNextFrame
-        JpgStartOfScan ->
-            (\frm imgData ->
-                let (d, other) = extractScanContent imgData
-                in
-                case runGet parseFrames (L.drop 1 other) of
-                  Left _ -> [JpgScanBlob frm d]
-                  Right lst -> JpgScanBlob frm d : lst
-            ) <$> get <*> getRemainingLazyBytes
-
-        _ -> (\hdr lst -> JpgScans kind hdr : lst) <$> get <*> parseNextFrame
-
-buildPackedHuffmanTree :: V.Vector (VU.Vector Word8) -> HuffmanTree
-buildPackedHuffmanTree = buildHuffmanTree . map VU.toList . V.toList
-
-secondStartOfFrameByteOfKind :: JpgFrameKind -> Word8
-secondStartOfFrameByteOfKind = aux
-  where
-    aux JpgBaselineDCTHuffman = 0xC0
-    aux JpgExtendedSequentialDCTHuffman = 0xC1
-    aux JpgProgressiveDCTHuffman = 0xC2
-    aux JpgLosslessHuffman = 0xC3
-    aux JpgDifferentialSequentialDCTHuffman = 0xC5
-    aux JpgDifferentialProgressiveDCTHuffman = 0xC6
-    aux JpgDifferentialLosslessHuffman = 0xC7
-    aux JpgExtendedSequentialArithmetic = 0xC9
-    aux JpgProgressiveDCTArithmetic = 0xCA
-    aux JpgLosslessArithmetic = 0xCB
-    aux JpgHuffmanTableMarker = 0xC4
-    aux JpgDifferentialSequentialDCTArithmetic = 0xCD
-    aux JpgDifferentialProgressiveDCTArithmetic = 0xCE
-    aux JpgDifferentialLosslessArithmetic = 0xCF
-    aux JpgEndOfImage = 0xD9
-    aux JpgQuantizationTable = 0xDB
-    aux JpgStartOfScan = 0xDA
-    aux JpgRestartInterval = 0xDD
-    aux (JpgRestartIntervalEnd v) = v
-    aux (JpgAppSegment a) = a
-    aux (JpgExtensionSegment a) = a
-
-data JpgImageKind = BaseLineDCT | ProgressiveDCT
-
-instance Binary JpgFrameKind where
-    put v = putWord8 0xFF >> put (secondStartOfFrameByteOfKind v)
-    get = do
-        -- no lookahead :(
-        {-word <- getWord8-}
-        word2 <- getWord8
-        return $ case word2 of
-            0xC0 -> JpgBaselineDCTHuffman
-            0xC1 -> JpgExtendedSequentialDCTHuffman
-            0xC2 -> JpgProgressiveDCTHuffman
-            0xC3 -> JpgLosslessHuffman
-            0xC4 -> JpgHuffmanTableMarker
-            0xC5 -> JpgDifferentialSequentialDCTHuffman
-            0xC6 -> JpgDifferentialProgressiveDCTHuffman
-            0xC7 -> JpgDifferentialLosslessHuffman
-            0xC9 -> JpgExtendedSequentialArithmetic
-            0xCA -> JpgProgressiveDCTArithmetic
-            0xCB -> JpgLosslessArithmetic
-            0xCD -> JpgDifferentialSequentialDCTArithmetic
-            0xCE -> JpgDifferentialProgressiveDCTArithmetic
-            0xCF -> JpgDifferentialLosslessArithmetic
-            0xD9 -> JpgEndOfImage
-            0xDA -> JpgStartOfScan
-            0xDB -> JpgQuantizationTable
-            0xDD -> JpgRestartInterval
-            a | a >= 0xF0 -> JpgExtensionSegment a
-              | a >= 0xE0 -> JpgAppSegment a
-              | a >= 0xD0 && a <= 0xD7 -> JpgRestartIntervalEnd a
-              | otherwise -> error ("Invalid frame marker (" ++ show a ++ ")")
-
-put4BitsOfEach :: Word8 -> Word8 -> Put
-put4BitsOfEach a b = put $ (a `unsafeShiftL` 4) .|. b
-
-get4BitOfEach :: Get (Word8, Word8)
-get4BitOfEach = do
-    val <- get
-    return ((val `unsafeShiftR` 4) .&. 0xF, val .&. 0xF)
-
-newtype RestartInterval = RestartInterval Word16
-
-instance Binary RestartInterval where
-    put (RestartInterval i) = putWord16be 4 >> putWord16be i
-    get = do
-        size <- getWord16be
-        when (size /= 4) (fail "Invalid jpeg restart interval size")
-        RestartInterval <$> getWord16be
-
-instance Binary JpgComponent where
-    get = do
-        ident <- getWord8
-        (horiz, vert) <- get4BitOfEach
-        quantTableIndex <- getWord8
-        return JpgComponent
-            { componentIdentifier = ident
-            , horizontalSamplingFactor = horiz
-            , verticalSamplingFactor = vert
-            , quantizationTableDest = quantTableIndex
-            }
-    put v = do
-        put $ componentIdentifier v
-        put4BitsOfEach (horizontalSamplingFactor v) $ verticalSamplingFactor v
-        put $ quantizationTableDest v
-
-instance Binary JpgFrameHeader where
-    get = do
-        beginOffset <- fromIntegral <$> bytesRead
-        frmHLength <- getWord16be
-        samplePrec <- getWord8
-        h <- getWord16be
-        w <- getWord16be
-        compCount <- getWord8
-        components <- replicateM (fromIntegral compCount) get
-        endOffset <- fromIntegral <$> bytesRead
-        when (beginOffset - endOffset < fromIntegral frmHLength)
-             (skip $ fromIntegral frmHLength - (endOffset - beginOffset))
-        return JpgFrameHeader
-            { jpgFrameHeaderLength = frmHLength
-            , jpgSamplePrecision = samplePrec
-            , jpgHeight = h
-            , jpgWidth = w
-            , jpgImageComponentCount = compCount
-            , jpgComponents = components
-            }
-
-    put v = do
-        putWord16be $ jpgFrameHeaderLength v
-        putWord8    $ jpgSamplePrecision v
-        putWord16be $ jpgHeight v
-        putWord16be $ jpgWidth v
-        putWord8    $ jpgImageComponentCount v
-        mapM_ put   $ jpgComponents v
-
-instance Binary JpgScanSpecification where
-    put v = do
-        put $ componentSelector v
-        put4BitsOfEach (dcEntropyCodingTable v) $ acEntropyCodingTable v
-
-    get = do
-        compSel <- get
-        (dc, ac) <- get4BitOfEach
-        return JpgScanSpecification {
-            componentSelector = compSel
-          , dcEntropyCodingTable = dc
-          , acEntropyCodingTable = ac
-          }
-
-instance Binary JpgScanHeader where
-    get = do
-        thisScanLength <- getWord16be
-        compCount <- getWord8
-        comp <- replicateM (fromIntegral compCount) get
-        specBeg <- get
-        specEnd <- get
-        (approxHigh, approxLow) <- get4BitOfEach
-
-        return JpgScanHeader {
-            scanLength = thisScanLength,
-            scanComponentCount = compCount,
-            scans = comp,
-            spectralSelection = (specBeg, specEnd),
-            successiveApproxHigh = approxHigh,
-            successiveApproxLow = approxLow
-        }
-
-    put v = do
-        putWord16be $ scanLength v
-        putWord8 $ scanComponentCount v
-        mapM_ put $ scans v
-        putWord8 . fst $ spectralSelection v
-        putWord8 . snd $ spectralSelection v
-        put4BitsOfEach (successiveApproxHigh v) $ successiveApproxLow v
-
-{-# INLINE createEmptyMutableMacroBlock #-}
--- | Create a new macroblock with the good array size
-createEmptyMutableMacroBlock :: (Storable a, Num a) => ST s (MutableMacroBlock s a)
-createEmptyMutableMacroBlock = M.replicate 64 0
-
-printMacroBlock :: (Storable a, PrintfArg a)
-                => MutableMacroBlock s a -> ST s String
-printMacroBlock block = pLn 0
-    where pLn 64 = return "===============================\n"
-          pLn i = do
-              v <- block `M.unsafeRead` i
-              vn <- pLn (i+1)
-              return $ printf (if i `mod` 8 == 0 then "\n%5d " else "%5d ") v ++ vn
-
-printPureMacroBlock :: (Storable a, PrintfArg a) => MacroBlock a -> String
-printPureMacroBlock block = pLn 0
-    where pLn 64 = "===============================\n"
-          pLn i = str ++ pLn (i + 1)
-            where str | i `mod` 8 == 0 = printf "\n%5d " v
-                      | otherwise = printf "%5d" v
-                  v = block VS.! i
-
-
-{-# INLINE dctBlockSize #-}
-dctBlockSize :: Num a => a
-dctBlockSize = 8

@@ -1,500 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE ViewPatterns #-}
--- | Module used for loading & writing \'Portable Network Graphics\' (PNG)
--- files. The API has two layers, the high level, which load the image without
--- looking deeply about it and the low level, allowing access to data chunks contained
--- in the PNG image.
---
--- For general use, please use 'decodePng' function.
---
--- The loader has been validated against the pngsuite (http://www.libpng.org/pub/png/pngsuite.html)
-module Codec.Picture.Png( -- * High level functions
-                          PngSavable( .. )
-
-                        , decodePng
-                        , writePng
-                        , encodeDynamicPng
-                        , writeDynamicPng
-
-                        ) where
-
-import Control.Applicative( (<$>) )
-import Control.Monad( forM_, foldM_, when )
-import Control.Monad.ST( ST, runST )
-import Data.Binary( Binary( get) )
-
-import qualified Data.Vector.Storable as V
-import qualified Data.Vector.Storable.Mutable as M
-import Data.Bits( (.&.), (.|.), unsafeShiftL, unsafeShiftR )
-import Data.List( find, zip4 )
-import Data.Word( Word8, Word16, Word32 )
-import qualified Codec.Compression.Zlib as Z
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Unsafe as BU
-import qualified Data.ByteString.Lazy as Lb
-import Foreign.Storable ( Storable )
-
-import Codec.Picture.Types
-import Codec.Picture.Png.Type
-import Codec.Picture.Png.Export
-import Codec.Picture.InternalHelper
-
--- | Simple structure used to hold information about Adam7 deinterlacing.
--- A structure is used to avoid pollution of the module namespace.
-data Adam7MatrixInfo = Adam7MatrixInfo
-    { adam7StartingRow  :: [Int]
-    , adam7StartingCol  :: [Int]
-    , adam7RowIncrement :: [Int]
-    , adam7ColIncrement :: [Int]
-    , adam7BlockHeight  :: [Int]
-    , adam7BlockWidth   :: [Int]
-    }
-
--- | The real info about the matrix.
-adam7MatrixInfo :: Adam7MatrixInfo
-adam7MatrixInfo = Adam7MatrixInfo
-    { adam7StartingRow  = [0, 0, 4, 0, 2, 0, 1]
-    , adam7StartingCol  = [0, 4, 0, 2, 0, 1, 0]
-    , adam7RowIncrement = [8, 8, 8, 4, 4, 2, 2]
-    , adam7ColIncrement = [8, 8, 4, 4, 2, 2, 1]
-    , adam7BlockHeight  = [8, 8, 4, 4, 2, 2, 1]
-    , adam7BlockWidth   = [8, 4, 4, 2, 2, 1, 1]
-    }
-
-unparsePngFilter :: Word8 -> Either String PngFilter
-{-# INLINE unparsePngFilter #-}
-unparsePngFilter 0 = Right FilterNone
-unparsePngFilter 1 = Right FilterSub
-unparsePngFilter 2 = Right FilterUp
-unparsePngFilter 3 = Right FilterAverage
-unparsePngFilter 4 = Right FilterPaeth
-unparsePngFilter _ = Left "Invalid scanline filter"
-
-getBounds :: (Monad m, Storable a) => M.STVector s a -> m (Int, Int)
-{-# INLINE getBounds #-}
-getBounds v = return (0, M.length v - 1)
-
--- | Apply a filtering method on a reduced image. Apply the filter
--- on each line, using the previous line (the one above it) to perform
--- some prediction on the value.
-pngFiltering :: LineUnpacker s -> Int -> (Int, Int)    -- ^ Image size
-             -> B.ByteString -> Int
-             -> ST s Int
-pngFiltering _ _ (imgWidth, imgHeight) _str initialIdx
-        | imgWidth <= 0 || imgHeight <= 0 = return initialIdx
-pngFiltering unpacker beginZeroes (imgWidth, imgHeight) str initialIdx = do
-    thisLine <- M.replicate (beginZeroes + imgWidth) 0
-    otherLine <- M.replicate (beginZeroes + imgWidth) 0
-    let folder            _          _  lineIndex !idx | lineIndex >= imgHeight = return idx
-        folder previousLine currentLine lineIndex !idx = do
-               let byte = str `BU.unsafeIndex` idx
-               let lineFilter = case unparsePngFilter byte of
-                       Right FilterNone    -> filterNone
-                       Right FilterSub     -> filterSub
-                       Right FilterAverage -> filterAverage
-                       Right FilterUp      -> filterUp
-                       Right FilterPaeth   -> filterPaeth
-                       _ -> filterNone
-               idx' <- lineFilter previousLine currentLine $ idx + 1
-               unpacker lineIndex (stride, currentLine)
-               folder currentLine previousLine (lineIndex + 1) idx'
-
-    folder thisLine otherLine (0 :: Int) initialIdx
-
-    where stride = fromIntegral beginZeroes
-          lastIdx = beginZeroes + imgWidth - 1
-
-          -- The filter implementation are... well non-idiomatic
-          -- to say the least, but my benchmarks proved me one thing,
-          -- they are faster than mapM_, gained something like 5% with
-          -- a rewrite from mapM_ to this direct version
-          filterNone, filterSub, filterUp, filterPaeth,
-                filterAverage :: PngLine s -> PngLine s -> Int -> ST s Int
-          filterNone !_previousLine !thisLine = inner beginZeroes
-            where inner idx !readIdx
-                            | idx > lastIdx = return readIdx
-                            | otherwise = do let byte = str `BU.unsafeIndex` readIdx
-                                             (thisLine `M.unsafeWrite` idx) byte
-                                             inner (idx + 1) $ readIdx + 1
-
-          filterSub !_previousLine !thisLine = inner beginZeroes
-            where inner idx !readIdx
-                            | idx > lastIdx = return readIdx
-                            | otherwise = do let byte = str `BU.unsafeIndex` readIdx
-                                             val <- thisLine `M.unsafeRead` (idx - stride)
-                                             (thisLine `M.unsafeWrite` idx) $ byte + val
-                                             inner (idx + 1) $ readIdx + 1
-
-          filterUp !previousLine !thisLine = inner beginZeroes
-            where inner idx !readIdx
-                            | idx > lastIdx = return readIdx
-                            | otherwise = do let byte = str `BU.unsafeIndex` readIdx
-                                             val <- previousLine `M.unsafeRead` idx
-                                             (thisLine `M.unsafeWrite` idx) $ val + byte
-                                             inner (idx + 1) $ readIdx + 1
-
-          filterAverage !previousLine !thisLine = inner beginZeroes
-            where inner idx !readIdx
-                            | idx > lastIdx = return readIdx
-                            | otherwise = do let byte = str `BU.unsafeIndex` readIdx
-                                             valA <- thisLine `M.unsafeRead` (idx - stride)
-                                             valB <- previousLine `M.unsafeRead` idx
-                                             let a' = fromIntegral valA
-                                                 b' = fromIntegral valB
-                                                 average = fromIntegral ((a' + b') `div` (2 :: Word16)) 
-                                                 writeVal = byte + average 
-                                             (thisLine `M.unsafeWrite` idx) $ writeVal
-                                             inner (idx + 1) $ readIdx + 1
-
-          filterPaeth !previousLine !thisLine = inner beginZeroes
-            where inner idx !readIdx
-                            | idx > lastIdx = return readIdx
-                            | otherwise = do let byte = str `BU.unsafeIndex` readIdx
-                                             valA <- thisLine `M.unsafeRead` (idx - stride)
-                                             valC <- previousLine `M.unsafeRead` (idx - stride)
-                                             valB <- previousLine `M.unsafeRead` idx
-                                             (thisLine `M.unsafeWrite` idx) $ byte + paeth valA valB valC
-                                             inner (idx + 1) $ readIdx + 1
-
-                  paeth a b c
-                    | pa <= pb && pa <= pc = a
-                    | pb <= pc             = b
-                    | otherwise            = c
-                      where a' = fromIntegral a :: Int
-                            b' = fromIntegral b
-                            c' = fromIntegral c
-                            p = a' + b' - c'
-                            pa = abs $ p - a'
-                            pb = abs $ p - b'
-                            pc = abs $ p - c'
-                  
--- | Directly stolen from the definition in the standard (on W3C page),
--- pixel predictor.
-
-type PngLine s = M.STVector s Word8
-type LineUnpacker s = Int -> (Int, PngLine s) -> ST s ()
-
-type StrideInfo  = (Int, Int)
-
-type BeginOffset = (Int, Int)
-
-
--- | Unpack lines where bit depth is 8
-byteUnpacker :: Int -> MutableImage s Word8 -> StrideInfo -> BeginOffset -> LineUnpacker s
-byteUnpacker sampleCount (MutableImage{ mutableImageWidth = imgWidth, mutableImageData = arr })
-             (strideWidth, strideHeight) (beginLeft, beginTop) h (beginIdx, line) = do
-    (_, maxIdx) <- getBounds line
-    let realTop = beginTop + h * strideHeight
-        lineIndex = realTop * imgWidth
-        pixelToRead = min (imgWidth - 1) $ (maxIdx - beginIdx) `div` sampleCount
-        inner pixelIndex | pixelIndex > pixelToRead = return ()
-                         | otherwise = do
-            let destPixelIndex = lineIndex + pixelIndex * strideWidth + beginLeft 
-                destSampleIndex = destPixelIndex * sampleCount
-                srcPixelIndex = pixelIndex * sampleCount + beginIdx
-                perPixel sample | sample >= sampleCount = return ()
-                                | otherwise = do
-                    val <- line `M.unsafeRead` (srcPixelIndex + sample)
-                    let writeIdx = destSampleIndex + sample
-                    (arr `M.unsafeWrite` writeIdx) val
-                    perPixel (sample + 1)
-            perPixel 0
-            inner (pixelIndex + 1)
-    inner 0
-             
-
--- | Unpack lines where bit depth is 1
-bitUnpacker :: Int -> MutableImage s Word8 -> StrideInfo -> BeginOffset -> LineUnpacker s
-bitUnpacker _ (MutableImage{ mutableImageWidth = imgWidth, mutableImageData = arr })
-              (strideWidth, strideHeight) (beginLeft, beginTop) h (beginIdx, line) = do
-    (_, endLine) <- getBounds line
-    let realTop = beginTop + h * strideHeight
-        lineIndex = realTop * imgWidth
-        (lineWidth, subImageRest) = (imgWidth - beginLeft) `divMod` strideWidth
-        subPadd | subImageRest > 0 = 1
-                | otherwise = 0
-        (pixelToRead, lineRest) = (lineWidth + subPadd) `divMod` 8
-    forM_ [0 .. pixelToRead - 1] $ \pixelIndex -> do
-        val <- line `M.unsafeRead` (pixelIndex  + beginIdx)
-        let writeIdx n = lineIndex + (pixelIndex * 8 + n) * strideWidth + beginLeft 
-        forM_ [0 .. 7] $ \bit -> (arr `M.unsafeWrite` writeIdx (7 - bit)) ((val `unsafeShiftR` bit) .&. 1)
-
-    when (lineRest /= 0)
-         (do val <- line `M.unsafeRead` endLine
-             let writeIdx n = lineIndex + (pixelToRead * 8 + n) * strideWidth + beginLeft
-             forM_ [0 .. lineRest - 1] $ \bit ->
-                (arr `M.unsafeWrite` writeIdx bit) ((val `unsafeShiftR` (7 - bit)) .&. 0x1))
-
-
--- | Unpack lines when bit depth is 2
-twoBitsUnpacker :: Int -> MutableImage s Word8 -> StrideInfo -> BeginOffset -> LineUnpacker s
-twoBitsUnpacker _ (MutableImage{ mutableImageWidth = imgWidth, mutableImageData = arr })
-                  (strideWidth, strideHeight) (beginLeft, beginTop) h (beginIdx, line) = do
-    (_, endLine) <- getBounds line
-    let realTop = beginTop + h * strideHeight
-        lineIndex = realTop * imgWidth
-        (lineWidth, subImageRest) = (imgWidth - beginLeft) `divMod` strideWidth
-        subPadd | subImageRest > 0 = 1
-                | otherwise = 0
-        (pixelToRead, lineRest) = (lineWidth + subPadd) `divMod` 4
-
-    forM_ [0 .. pixelToRead - 1] $ \pixelIndex -> do
-        val <- line `M.unsafeRead` (pixelIndex  + beginIdx)
-        let writeIdx n = lineIndex + (pixelIndex * 4 + n) * strideWidth + beginLeft 
-        (arr `M.unsafeWrite` writeIdx 0) $ (val `unsafeShiftR` 6) .&. 0x3
-        (arr `M.unsafeWrite` writeIdx 1) $ (val `unsafeShiftR` 4) .&. 0x3
-        (arr `M.unsafeWrite` writeIdx 2) $ (val `unsafeShiftR` 2) .&. 0x3
-        (arr `M.unsafeWrite` writeIdx 3) $ val .&. 0x3
-
-    when (lineRest /= 0)
-         (do val <- line `M.unsafeRead` endLine
-             let writeIdx n = lineIndex + (pixelToRead * 4 + n) * strideWidth + beginLeft
-             forM_ [0 .. lineRest - 1] $ \bit ->
-                (arr `M.unsafeWrite` writeIdx bit) ((val `unsafeShiftR` (6 - 2 * bit)) .&. 0x3))
-
-halfByteUnpacker :: Int -> MutableImage s Word8 -> StrideInfo -> BeginOffset -> LineUnpacker s
-halfByteUnpacker _ (MutableImage{ mutableImageWidth = imgWidth, mutableImageData = arr })
-                   (strideWidth, strideHeight) (beginLeft, beginTop) h (beginIdx, line) = do
-    (_, endLine) <- getBounds line
-    let realTop = beginTop + h * strideHeight
-        lineIndex = realTop * imgWidth
-        (lineWidth, subImageRest) = (imgWidth - beginLeft) `divMod` strideWidth
-        subPadd | subImageRest > 0 = 1
-                | otherwise = 0
-        (pixelToRead, lineRest) = (lineWidth + subPadd) `divMod` 2
-    forM_ [0 .. pixelToRead - 1] $ \pixelIndex -> do
-        val <- line `M.unsafeRead` (pixelIndex  + beginIdx)
-        let writeIdx n = lineIndex + (pixelIndex * 2 + n) * strideWidth + beginLeft 
-        (arr `M.unsafeWrite` writeIdx 0) $ (val `unsafeShiftR` 4) .&. 0xF
-        (arr `M.unsafeWrite` writeIdx 1) $ val .&. 0xF
-    
-    when (lineRest /= 0)
-         (do val <- line `M.unsafeRead` endLine
-             let writeIdx = lineIndex + (pixelToRead * 2) * strideWidth + beginLeft 
-             (arr `M.unsafeWrite` writeIdx) $ (val `unsafeShiftR` 4) .&. 0xF)
-
-shortUnpacker :: Int -> MutableImage s Word16 -> StrideInfo -> BeginOffset -> LineUnpacker s
-shortUnpacker sampleCount (MutableImage{ mutableImageWidth = imgWidth, mutableImageData = arr })
-             (strideWidth, strideHeight) (beginLeft, beginTop) h (beginIdx, line) = do
-    (_, maxIdx) <- getBounds line
-    let realTop = beginTop + h * strideHeight
-        lineIndex = realTop * imgWidth
-        pixelToRead = min (imgWidth - 1) $ (maxIdx - beginIdx) `div` (sampleCount * 2)
-    forM_ [0 .. pixelToRead] $ \pixelIndex -> do
-        let destPixelIndex = lineIndex + pixelIndex * strideWidth + beginLeft 
-            destSampleIndex = destPixelIndex * sampleCount
-            srcPixelIndex = pixelIndex * sampleCount * 2 + beginIdx
-        forM_ [0 .. sampleCount - 1] $ \sample -> do
-            highBits <- line `M.unsafeRead` (srcPixelIndex + sample * 2 + 0)
-            lowBits <- line `M.unsafeRead` (srcPixelIndex + sample * 2 + 1)
-            let fullValue = fromIntegral lowBits .|. (fromIntegral highBits `unsafeShiftL` 8)
-                writeIdx = destSampleIndex + sample
-            (arr `M.unsafeWrite` writeIdx) $ fullValue
-
--- | Transform a scanline to a bunch of bytes. Bytes are then packed
--- into pixels at a further step.
-scanlineUnpacker8 :: Int -> Int -> MutableImage s Word8 -> StrideInfo -> BeginOffset
-                 -> LineUnpacker s
-scanlineUnpacker8 1 = bitUnpacker
-scanlineUnpacker8 2 = twoBitsUnpacker
-scanlineUnpacker8 4 = halfByteUnpacker
-scanlineUnpacker8 8 = byteUnpacker
-scanlineUnpacker8 _ = error "Impossible bit depth"
-
-byteSizeOfBitLength :: Int -> Int -> Int -> Int
-byteSizeOfBitLength pixelBitDepth sampleCount dimension = size + (if rest /= 0 then 1 else 0)
-   where (size, rest) = (pixelBitDepth * dimension * sampleCount) `quotRem` 8
-
-scanLineInterleaving :: Int -> Int -> (Int, Int) -> (StrideInfo -> BeginOffset -> LineUnpacker s)
-                     -> B.ByteString
-                     -> ST s ()
-scanLineInterleaving depth sampleCount (imgWidth, imgHeight) unpacker str =
-    pngFiltering (unpacker (1,1) (0, 0)) strideInfo (byteWidth, imgHeight) str 0 >> return ()
-        where byteWidth = byteSizeOfBitLength depth sampleCount imgWidth
-              strideInfo | depth < 8 = 1
-                         | otherwise = sampleCount * (depth `div` 8)
-
--- | Given data and image size, recreate an image with deinterlaced
--- data for PNG's adam 7 method.
-adam7Unpack :: Int -> Int -> (Int, Int) -> (StrideInfo -> BeginOffset -> LineUnpacker s)
-            -> B.ByteString -> ST s ()
-adam7Unpack depth sampleCount (imgWidth, imgHeight) unpacker str =
-  foldM_ (\i f -> f i) 0 subImages >> return ()
-    where Adam7MatrixInfo { adam7StartingRow  = startRows
-                          , adam7RowIncrement = rowIncrement
-                          , adam7StartingCol  = startCols
-                          , adam7ColIncrement = colIncrement } = adam7MatrixInfo
-
-          subImages = 
-              [pngFiltering (unpacker (incrW, incrH) (beginW, beginH)) strideInfo (byteWidth, passHeight) str
-                            | (beginW, incrW, beginH, incrH) <- zip4 startCols colIncrement startRows rowIncrement
-                            , let passWidth = sizer imgWidth beginW incrW
-                                  passHeight = sizer imgHeight beginH incrH
-                                  byteWidth = byteSizeOfBitLength depth sampleCount passWidth
-                            ]
-          strideInfo | depth < 8 = 1
-                     | otherwise = sampleCount * (depth `div` 8)
-          sizer dimension begin increment
-            | dimension <= begin = 0
-            | otherwise = outDim + (if restDim /= 0 then 1 else 0)
-                where (outDim, restDim) = (dimension - begin) `quotRem` increment
-
--- | deinterlace picture in function of the method indicated
--- in the iHDR
-deinterlacer :: PngIHdr -> B.ByteString -> ST s (Either (V.Vector Word8) (V.Vector Word16))
-deinterlacer (PngIHdr { width = w, height = h, colourType  = imgKind
-                      , interlaceMethod = method, bitDepth = depth  }) str = do
-    let compCount = sampleCountOfImageType imgKind 
-        arraySize = fromIntegral $ w * h * compCount
-        deinterlaceFunction = case method of
-            PngNoInterlace -> scanLineInterleaving
-            PngInterlaceAdam7 -> adam7Unpack
-        iBitDepth = fromIntegral depth
-    if iBitDepth <= 8
-      then do
-        imgArray <- M.new arraySize
-        let mutableImage = MutableImage (fromIntegral w) (fromIntegral h) imgArray
-        deinterlaceFunction iBitDepth 
-                            (fromIntegral compCount)
-                            (fromIntegral w, fromIntegral h)
-                            (scanlineUnpacker8 iBitDepth (fromIntegral compCount)
-                                                         mutableImage)
-                            str
-        Left <$> V.unsafeFreeze imgArray
-
-      else do
-        imgArray <- M.new arraySize
-        let mutableImage = MutableImage (fromIntegral w) (fromIntegral h) imgArray
-        deinterlaceFunction iBitDepth 
-                            (fromIntegral compCount)
-                            (fromIntegral w, fromIntegral h)
-                            (shortUnpacker (fromIntegral compCount) mutableImage)
-                            str
-        Right <$> V.unsafeFreeze imgArray
-
-generateGreyscalePalette :: Word8 -> PngPalette
-generateGreyscalePalette times = Image possibilities 0 vec
-    where possibilities = 2 ^ times - 1
-          vec = V.fromListN ((fromIntegral possibilities + 1) * 3) $ concat pixels
-          pixels = [[i, i, i] | n <- [0 .. possibilities]
-                              , let i = fromIntegral $ n * (255 `div` possibilities)]
-
-sampleCountOfImageType :: PngImageType -> Word32
-sampleCountOfImageType PngGreyscale = 1
-sampleCountOfImageType PngTrueColour = 3
-sampleCountOfImageType PngIndexedColor = 1
-sampleCountOfImageType PngGreyscaleWithAlpha = 2
-sampleCountOfImageType PngTrueColourWithAlpha = 4
-
-paletteRGBA1, paletteRGBA2, paletteRGBA4 :: PngPalette
-paletteRGBA1 = generateGreyscalePalette 1
-paletteRGBA2 = generateGreyscalePalette 2
-paletteRGBA4 = generateGreyscalePalette 4
-
-{-# INLINE bounds #-}
-bounds :: Storable a => V.Vector a -> (Int, Int)
-bounds v = (0, V.length v - 1)
-
-applyPalette :: PngPalette -> V.Vector Word8 -> V.Vector Word8
-applyPalette pal img = V.fromListN ((initSize + 1) * 3) pixels
-    where (_, initSize) = bounds img
-          pixels = concat [[r, g, b] | ipx <- V.toList img
-                                     , let PixelRGB8 r g b = pixelAt pal (fromIntegral ipx) 0]
-
-applyPaletteWithTransparency :: PngPalette -> Word8 -> V.Vector Word8 -> V.Vector Word8
-applyPaletteWithTransparency pal transp img = V.fromListN ((initSize + 1) * 4) pixels
-    where (_, initSize) = bounds img
-          pixels = concat [ if ipx == transp then [0, 0, 0, 0] else [r, g, b, 255]
-                                     | ipx <- V.toList img
-                                     , let PixelRGB8 r g b = pixelAt pal (fromIntegral ipx) 0]
-
--- | Transform a raw png image to an image, without modifying the
--- underlying pixel type. If the image is greyscale and < 8 bits,
--- a transformation to RGBA8 is performed. This should change
--- in the future.
--- The resulting image let you manage the pixel types.
---
--- This function can output the following pixel types :
---
---    * PixelY8
---
---    * PixelY16
---
---    * PixelYA8
---
---    * PixelYA16
---
---    * PixelRGB8
---
---    * PixelRGB16
---
---    * PixelRGBA8
---
---    * PixelRGBA16
---
-decodePng :: B.ByteString -> Either String DynamicImage
-decodePng byte = do
-    rawImg <- runGetStrict get byte
-    let ihdr@(PngIHdr { width = w, height = h }) = header rawImg
-        compressedImageData =
-              Lb.concat [chunkData chunk | chunk <- chunks rawImg
-                                        , chunkType chunk == iDATSignature]
-        zlibHeaderSize = 1 {- compression method/flags code -}
-                       + 1 {- Additional flags/check bits -}
-                       + 4 {-CRC-}
-
-        toImage const1 _const2 (Left a) =
-            Right . const1 $ Image (fromIntegral w) (fromIntegral h) a
-        toImage _const1 const2 (Right a) =
-            Right . const2 $ Image (fromIntegral w) (fromIntegral h) a
-
-        palette8 palette [(Lb.uncons -> Just (c,_))] (Left img) =
-            Right . ImageRGBA8
-                  . Image (fromIntegral w) (fromIntegral h)
-                  $ applyPaletteWithTransparency palette c img
-
-        palette8 palette _ (Left img) =
-            Right . ImageRGB8
-                  . Image (fromIntegral w) (fromIntegral h)
-                  $ applyPalette palette img
-
-        palette8 _ _ (Right _) = Left "Invalid bit depth for paleted image"
-
-        transparencyColor =
-            [ chunkData chunk | chunk <- chunks rawImg
-                              , chunkType chunk == tRNSSignature ]
-
-        unparse _ t PngGreyscale bytes
-            | bitDepth ihdr == 1 = unparse (Just paletteRGBA1) t PngIndexedColor bytes
-            | bitDepth ihdr == 2 = unparse (Just paletteRGBA2) t PngIndexedColor bytes
-            | bitDepth ihdr == 4 = unparse (Just paletteRGBA4) t PngIndexedColor bytes
-            | otherwise = toImage ImageY8 ImageY16 $ runST stArray
-                where stArray = deinterlacer ihdr bytes
-
-        unparse Nothing _ PngIndexedColor  _ = Left "no valid palette found"
-        unparse _ _ PngTrueColour          bytes =
-            toImage ImageRGB8 ImageRGB16 $ runST stArray
-                where stArray = deinterlacer ihdr bytes
-        unparse _ _ PngGreyscaleWithAlpha  bytes =
-            toImage ImageYA8 ImageYA16 $ runST stArray
-                where stArray = deinterlacer ihdr bytes
-        unparse _ _ PngTrueColourWithAlpha bytes =
-            toImage ImageRGBA8 ImageRGBA16 $ runST stArray
-                where stArray = deinterlacer ihdr bytes
-        unparse (Just plte) transparency PngIndexedColor bytes =
-            palette8 plte transparency $ runST stArray
-                where stArray = deinterlacer ihdr bytes
-
-    if Lb.length compressedImageData <= zlibHeaderSize
-       then Left "Invalid data size"
-       else let imgData = Z.decompress compressedImageData
-       	        parseableData = B.concat $ Lb.toChunks imgData
-                palette = case find (\c -> pLTESignature == chunkType c) $ chunks rawImg of
-                    Nothing -> Nothing
-                    Just p -> case parsePalette p of
-                            Left _ -> Nothing
-                            Right plte -> Just plte
-            in unparse palette transparencyColor (colourType ihdr) parseableData
-

@@ -1,163 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE TypeFamilies #-}
--- | Module implementing a basic png export, no filtering is applyed, but
--- export at least valid images.
-module Codec.Picture.Png.Export( PngSavable( .. )
-                               , writePng
-                               , encodeDynamicPng
-                               , writeDynamicPng
-                               ) where
-
-import Control.Monad( forM_ )
-import Control.Monad.ST( ST, runST )
-import Data.Bits( unsafeShiftR, (.&.) )
-import Data.Binary( encode )
-import Data.Word(Word8, Word16)
-import qualified Codec.Compression.Zlib as Z
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Lazy as Lb
-
-import qualified Data.Vector.Storable as VS
-import qualified Data.Vector.Storable.Mutable as M
-
-import Codec.Picture.Types
-import Codec.Picture.Png.Type
-import Codec.Picture.VectorByteConversion( blitVector )
-
--- | Encode an image into a png if possible.
-class PngSavable a where
-    -- | Transform an image into a png encoded bytestring, ready
-    -- to be written as a file.
-    encodePng :: Image a -> Lb.ByteString
-
-preparePngHeader :: Image a -> PngImageType -> Word8 -> PngIHdr
-preparePngHeader (Image { imageWidth = w, imageHeight = h }) imgType depth = PngIHdr
-    { width             = fromIntegral w
-    , height            = fromIntegral h
-    , bitDepth          = depth
-    , colourType        = imgType
-    , compressionMethod = 0
-    , filterMethod      = 0
-    , interlaceMethod   = PngNoInterlace
-    }
-
--- | Helper function to directly write an image as a png on disk.
-writePng :: (PngSavable pixel) => FilePath -> Image pixel -> IO ()
-writePng path img = Lb.writeFile path $ encodePng img
-
-endChunk :: PngRawChunk
-endChunk = PngRawChunk { chunkLength = 0
-                       , chunkType = iENDSignature
-                       , chunkCRC = pngComputeCrc [iENDSignature]
-                       , chunkData = Lb.empty
-                       }
-
-
-prepareIDatChunk :: Lb.ByteString -> PngRawChunk
-prepareIDatChunk imgData = PngRawChunk
-    { chunkLength = fromIntegral $ Lb.length imgData
-    , chunkType   = iDATSignature
-    , chunkCRC    = pngComputeCrc [iDATSignature, imgData]
-    , chunkData   = imgData
-    }
-
-genericEncode16BitsPng :: (PixelBaseComponent a ~ Word16)
-                       => PngImageType -> Int -> Image a -> Lb.ByteString
-genericEncode16BitsPng imgKind compCount 
-                 image@(Image { imageWidth = w, imageHeight = h, imageData = arr }) =
-  encode PngRawImage { header = hdr, chunks = [prepareIDatChunk imgEncodedData, endChunk]}
-    where hdr = preparePngHeader image imgKind 16
-          zero = B.singleton 0
-
-          lineSize = compCount * w
-          toByteString vec = blitVector vec 0 (lineSize * 2)
-          encodeLine line = toByteString $ runST $ do
-              finalVec <- M.new $ lineSize * 2 :: ST s (M.STVector s Word8)
-              let baseIndex = line * lineSize
-              forM_ [0 ..  lineSize - 1] $ \ix -> do
-                  let v = arr `VS.unsafeIndex` (baseIndex + ix)
-                      high = fromIntegral $ (v `unsafeShiftR` 8) .&. 0xFF
-                      low = fromIntegral $ v .&. 0xFF
-
-                  (finalVec `M.unsafeWrite` (ix * 2 + 0)) high
-                  (finalVec `M.unsafeWrite` (ix * 2 + 1)) low
-
-              VS.unsafeFreeze finalVec
-
-          imgEncodedData = Z.compress . Lb.fromChunks
-                        $ concat [[zero, encodeLine line] | line <- [0 .. h - 1]]
-
-
-genericEncodePng :: (PixelBaseComponent a ~ Word8)
-                 => PngImageType -> Int -> Image a -> Lb.ByteString
-genericEncodePng imgKind compCount 
-                 image@(Image { imageWidth = w, imageHeight = h, imageData = arr }) =
-  encode PngRawImage { header = hdr, chunks = [prepareIDatChunk imgEncodedData, endChunk]}
-    where hdr = preparePngHeader image imgKind 8
-          zero = B.singleton 0
-
-          lineSize = compCount * w
-          encodeLine line = blitVector arr (line * lineSize) lineSize
-          imgEncodedData = Z.compress . Lb.fromChunks
-                        $ concat [[zero, encodeLine line] | line <- [0 .. h - 1]]
-
-instance PngSavable PixelRGBA8 where
-    encodePng = genericEncodePng PngTrueColourWithAlpha 4
-        
-instance PngSavable PixelRGB8 where
-    encodePng = genericEncodePng PngTrueColour 3
-
-instance PngSavable Pixel8 where
-    encodePng = genericEncodePng PngGreyscale 1
-
-instance PngSavable PixelYA8 where
-    encodePng = genericEncodePng PngGreyscaleWithAlpha 2
-
-instance PngSavable PixelYA16 where
-    encodePng = genericEncode16BitsPng PngGreyscaleWithAlpha 2
-
-instance PngSavable Pixel16 where
-    encodePng = genericEncode16BitsPng PngGreyscale 1
-
-instance PngSavable PixelRGB16 where
-    encodePng = genericEncode16BitsPng PngTrueColour 3
-
-instance PngSavable PixelRGBA16 where
-    encodePng = genericEncode16BitsPng PngTrueColourWithAlpha 4
-
--- | Write a dynamic image in a .png image file if possible.
--- The same restriction as encodeDynamicPng apply.
-writeDynamicPng :: FilePath -> DynamicImage -> IO (Either String Bool)
-writeDynamicPng path img = case encodeDynamicPng img of
-        Left err -> return $ Left err
-        Right b  -> Lb.writeFile path b >> return (Right True)
-
--- | Encode a dynamic image in bmp if possible, supported pixel type are :
---
---   - Y8
---
---   - Y16
---
---   - YA8
---
---   - YA16
---
---   - RGB8
---
---   - RGB16
---
---   - RGBA8
---
---   - RGBA16
---
-encodeDynamicPng :: DynamicImage -> Either String Lb.ByteString
-encodeDynamicPng (ImageRGB8 img) = Right $ encodePng img
-encodeDynamicPng (ImageRGBA8 img) = Right $ encodePng img
-encodeDynamicPng (ImageY8 img) = Right $ encodePng img
-encodeDynamicPng (ImageY16 img) = Right $ encodePng img
-encodeDynamicPng (ImageYA8 img) = Right $ encodePng img
-encodeDynamicPng (ImageYA16 img) = Right $ encodePng img
-encodeDynamicPng (ImageRGB16 img) = Right $ encodePng img
-encodeDynamicPng (ImageRGBA16 img) = Right $ encodePng img
-encodeDynamicPng _ = Left "Unsupported image format for PNG export"

@@ -1,329 +0,0 @@--- | Low level png module, you should import 'Codec.Picture.Png' instead.
-module Codec.Picture.Png.Type( PngIHdr( .. )
-                             , PngFilter( .. )
-                             , PngInterlaceMethod( .. )
-                             , PngPalette
-                             , PngImageType( .. )
-                             , parsePalette 
-                             , pngComputeCrc
-                             , pLTESignature
-                             , iDATSignature
-                             , iENDSignature
-                             , tRNSSignature
-                             -- * Low level types
-                             , ChunkSignature
-                             , PngRawImage( .. )
-                             , PngChunk( .. )
-                             , PngRawChunk( .. )
-                             , PngLowLevel( .. )
-                             ) where
-
-import Control.Applicative( (<$>) )
-import Control.Monad( when, replicateM )
-import Data.Bits( xor, (.&.), unsafeShiftR )
-import Data.Binary( Binary(..), Get, get )
-import Data.Binary.Get( getWord8
-                      , getWord32be
-                      , getLazyByteString
-                      )
-import Data.Binary.Put( runPut
-                      , putWord8
-                      , putWord32be
-                      , putLazyByteString
-                      )
-import Data.Vector.Unboxed( Vector, fromListN, (!) )
-import qualified Data.Vector.Storable as V
-import Data.List( foldl' )
-import Data.Word( Word32, Word8 )
-import qualified Data.ByteString.Lazy as L
-import qualified Data.ByteString.Lazy.Char8 as LS
-
-import Codec.Picture.Types
-import Codec.Picture.InternalHelper
-
---------------------------------------------------
-----            Types
---------------------------------------------------
-
--- | Value used to identify a png chunk, must be 4 bytes long.
-type ChunkSignature = L.ByteString
-
--- | Generic header used in PNG images.
-data PngIHdr = PngIHdr
-    { width             :: Word32       -- ^ Image width in number of pixel
-    , height            :: Word32       -- ^ Image height in number of pixel
-    , bitDepth          :: Word8        -- ^ Number of bit per sample
-    , colourType        :: PngImageType -- ^ Kind of png image (greyscale, true color, indexed...)
-    , compressionMethod :: Word8        -- ^ Compression method used
-    , filterMethod      :: Word8        -- ^ Must be 0
-    , interlaceMethod   :: PngInterlaceMethod   -- ^ If the image is interlaced (for progressive rendering)
-    }
-    deriving Show
-
--- | What kind of information is encoded in the IDAT section
--- of the PngFile
-data PngImageType =
-      PngGreyscale
-    | PngTrueColour
-    | PngIndexedColor
-    | PngGreyscaleWithAlpha
-    | PngTrueColourWithAlpha
-    deriving Show
-
--- | Raw parsed image which need to be decoded.
-data PngRawImage = PngRawImage
-    { header       :: PngIHdr
-    , chunks       :: [PngRawChunk]
-    }
-
--- | Palette with indices beginning at 0 to elemcount - 1
-type PngPalette = Image PixelRGB8
-
--- | Parse a palette from a png chunk.
-parsePalette :: PngRawChunk -> Either String PngPalette
-parsePalette plte
- | chunkLength plte `mod` 3 /= 0 = Left "Invalid palette size"
- | otherwise = Image pixelCount 1 . V.fromListN (3 * pixelCount) <$> pixels
-    where pixelUnpacker = replicateM (fromIntegral pixelCount * 3) get
-          pixelCount = fromIntegral $ chunkLength plte `div` 3
-          pixels = runGet pixelUnpacker (chunkData plte)
-
--- | Data structure during real png loading/parsing
-data PngRawChunk = PngRawChunk
-    { chunkLength :: Word32
-    , chunkType   :: ChunkSignature
-    , chunkCRC    :: Word32
-    , chunkData   :: L.ByteString
-    }
-
--- | PNG chunk representing some extra information found in the parsed file.
-data PngChunk = PngChunk
-    { pngChunkData        :: L.ByteString  -- ^ The raw data inside the chunk
-    , pngChunkSignature   :: ChunkSignature -- ^ The name of the chunk.
-    }
-
--- | Low level access to PNG information
-data PngLowLevel a = PngLowLevel
-    { pngImage  :: Image a      -- ^ The real uncompressed image
-    , pngChunks :: [PngChunk]   -- ^ List of raw chunk where some user data might be present.
-    }
-
--- | The pixels value should be :
--- +---+---+
--- | c | b |
--- +---+---+
--- | a | x |
--- +---+---+
--- x being the current filtered pixel
-data PngFilter =
-    -- | Filt(x) = Orig(x), Recon(x) = Filt(x)
-      FilterNone
-    -- | Filt(x) = Orig(x) - Orig(a), 	Recon(x) = Filt(x) + Recon(a)
-    | FilterSub
-    -- | Filt(x) = Orig(x) - Orig(b), 	Recon(x) = Filt(x) + Recon(b)
-    | FilterUp
-    -- | Filt(x) = Orig(x) - floor((Orig(a) + Orig(b)) / 2),
-    -- Recon(x) = Filt(x) + floor((Recon(a) + Recon(b)) / 2)
-    | FilterAverage
-    -- | Filt(x) = Orig(x) - PaethPredictor(Orig(a), Orig(b), Orig(c)),
-    -- Recon(x) = Filt(x) + PaethPredictor(Recon(a), Recon(b), Recon(c))
-    | FilterPaeth
-    deriving (Enum, Show)
-
--- | Different known interlace methods for PNG image
-data PngInterlaceMethod =
-      -- | No interlacing, basic data ordering, line by line
-      -- from left to right.
-      PngNoInterlace
-
-      -- | Use the Adam7 ordering, see `adam7Reordering`
-    | PngInterlaceAdam7
-    deriving (Enum, Show)
-
---------------------------------------------------
-----            Instances
---------------------------------------------------
-instance Binary PngFilter where
-    put = putWord8 . toEnum . fromEnum
-    get = getWord8 >>= \w -> case w of
-        0 -> return FilterNone
-        1 -> return FilterSub
-        2 -> return FilterUp
-        3 -> return FilterAverage
-        4 -> return FilterPaeth
-        _ -> fail "Invalid scanline filter"
-
-instance Binary PngRawImage where
-    put img = do
-        putLazyByteString pngSignature
-        put $ header img
-        mapM_ put $ chunks img
-
-    get = parseRawPngImage
-
-instance Binary PngRawChunk where
-    put chunk = do
-        putWord32be $ chunkLength chunk
-        putLazyByteString $ chunkType chunk
-        when (chunkLength chunk /= 0)
-             (putLazyByteString $ chunkData chunk)
-        putWord32be $ chunkCRC chunk
-
-    get = do
-        size <- getWord32be
-        chunkSig <- getLazyByteString (fromIntegral $ L.length iHDRSignature)
-        imgData <- if size == 0
-            then return L.empty
-            else getLazyByteString (fromIntegral size)
-        crc <- getWord32be
-
-        let computedCrc = pngComputeCrc [chunkSig, imgData]
-        when (computedCrc `xor` crc /= 0)
-             (fail $ "Invalid CRC : " ++ show computedCrc ++ ", "
-                                      ++ show crc)
-        return PngRawChunk {
-        	chunkLength = size,
-        	chunkData = imgData,
-        	chunkCRC = crc,
-        	chunkType = chunkSig
-        }
-
-instance Binary PngIHdr where
-    put hdr = do
-        putWord32be 13
-        let inner = runPut $ do
-                putLazyByteString iHDRSignature
-                putWord32be $ width hdr
-                putWord32be $ height hdr
-                putWord8    $ bitDepth hdr
-                put $ colourType hdr
-                put $ compressionMethod hdr
-                put $ filterMethod hdr
-                put $ interlaceMethod hdr
-            crc = pngComputeCrc [inner]
-        putLazyByteString inner
-        putWord32be crc
-
-    get = do
-        _size <- getWord32be
-        ihdrSig <- getLazyByteString (L.length iHDRSignature)
-        when (ihdrSig /= iHDRSignature)
-             (fail "Invalid PNG file, wrong ihdr")
-        w <- getWord32be
-        h <- getWord32be
-        depth <- get
-        colorType <- get
-        compression <- get
-        filtermethod <- get
-        interlace <- get
-        _crc <- getWord32be
-        return PngIHdr {
-        	width = w,
-        	height = h,
-        	bitDepth = depth,
-        	colourType = colorType,
-            compressionMethod = compression,
-            filterMethod = filtermethod,
-            interlaceMethod = interlace
-        }
-
--- | Parse method for a png chunk, without decompression.
-parseChunks :: Get [PngRawChunk]
-parseChunks = do
-    chunk <- get
-
-    if chunkType chunk == iENDSignature
-       then return [chunk]
-       else (chunk:) <$> parseChunks
-
-
-instance Binary PngInterlaceMethod where
-    get = getWord8 >>= \w -> case w of
-        0 -> return PngNoInterlace
-        1 -> return PngInterlaceAdam7
-        _ -> fail "Invalid interlace method"
-
-    put PngNoInterlace    = putWord8 0
-    put PngInterlaceAdam7 = putWord8 1
-
--- | Implementation of the get method for the PngRawImage,
--- unpack raw data, without decompressing it.
-parseRawPngImage :: Get PngRawImage
-parseRawPngImage = do
-    sig <- getLazyByteString (L.length pngSignature)
-    when (sig /= pngSignature)
-         (fail "Invalid PNG file, signature broken")
-
-    ihdr <- get
-
-    chunkList <- parseChunks
-    return PngRawImage { header = ihdr, chunks = chunkList }
-
---------------------------------------------------
-----            functions
---------------------------------------------------
-
--- | Signature signalling that the following data will be a png image
--- in the png bit stream
-pngSignature :: ChunkSignature
-pngSignature = L.pack [137, 80, 78, 71, 13, 10, 26, 10]
-
--- | Helper function to help pack signatures.
-signature :: String -> ChunkSignature
-signature = LS.pack 
-
--- | Signature for the header chunk of png (must be the first)
-iHDRSignature :: ChunkSignature 
-iHDRSignature = signature "IHDR"
-
--- | Signature for a palette chunk in the pgn file. Must
--- occure before iDAT.
-pLTESignature :: ChunkSignature
-pLTESignature = signature "PLTE"
-
--- | Signature for a data chuck (with image parts in it)
-iDATSignature :: ChunkSignature
-iDATSignature = signature "IDAT"
-
--- | Signature for the last chunk of a png image, telling
--- the end.
-iENDSignature :: ChunkSignature
-iENDSignature = signature "IEND"
-
-tRNSSignature :: ChunkSignature
-tRNSSignature = signature "tRNS"
-
-instance Binary PngImageType where
-    put PngGreyscale = putWord8 0
-    put PngTrueColour = putWord8 2
-    put PngIndexedColor = putWord8 3
-    put PngGreyscaleWithAlpha = putWord8 4
-    put PngTrueColourWithAlpha = putWord8 6
-
-    get = get >>= imageTypeOfCode
-
-imageTypeOfCode :: Word8 -> Get PngImageType
-imageTypeOfCode 0 = return PngGreyscale
-imageTypeOfCode 2 = return PngTrueColour
-imageTypeOfCode 3 = return PngIndexedColor
-imageTypeOfCode 4 = return PngGreyscaleWithAlpha
-imageTypeOfCode 6 = return PngTrueColourWithAlpha
-imageTypeOfCode _ = fail "Invalid png color code"
-
--- | From the Annex D of the png specification.
-pngCrcTable :: Vector Word32
-pngCrcTable = fromListN 256 [ foldl' updateCrcConstant c [zero .. 7] | c <- [0 .. 255] ]
-    where zero = 0 :: Int -- To avoid defaulting to Integer
-          updateCrcConstant c _ | c .&. 1 /= 0 = magicConstant `xor` (c `unsafeShiftR` 1)
-                                | otherwise = c `unsafeShiftR` 1
-          magicConstant = 0xedb88320 :: Word32
-
--- | Compute the CRC of a raw buffer, as described in annex D of the PNG
--- specification.
-pngComputeCrc :: [L.ByteString] -> Word32
-pngComputeCrc = (0xFFFFFFFF `xor`) . L.foldl' updateCrc 0xFFFFFFFF . L.concat
-    where updateCrc crc val =
-              let u32Val = fromIntegral val
-                  lutVal = pngCrcTable ! (fromIntegral ((crc `xor` u32Val) .&. 0xFF))
-              in lutVal `xor` (crc `unsafeShiftR` 8)
-

@@ -1,165 +0,0 @@-{-# LANGUAGE TypeFamilies #-}
--- | Helper functions to save dynamic images to other file format
--- with automatic color space/sample format conversion done automatically.
-module Codec.Picture.Saving( imageToJpg
-                           , imageToPng
-                           , imageToBitmap
-                           , imageToTiff
-                           , imageToRadiance
-                           ) where
-
-import Data.Bits( unsafeShiftR )
-import Data.Word( Word8, Word16 )
-import qualified Data.ByteString.Lazy as L
-import Codec.Picture.Bitmap
-import Codec.Picture.Jpg
-import Codec.Picture.Png
-import Codec.Picture.HDR
-import Codec.Picture.Types
-import Codec.Picture.Tiff
-
-import qualified Data.Vector.Storable as V
-
-componentToLDR :: Float -> Word8
-componentToLDR = truncate . (255 *) . min 1.0 . max 0.0
-
-toStandardDef :: Image PixelRGBF -> Image PixelRGB8
-toStandardDef img = pixelMap pixelConverter img
-  where pixelConverter (PixelRGBF rf gf bf) = PixelRGB8 r g b
-          where r = componentToLDR rf
-                g = componentToLDR gf
-                b = componentToLDR bf
-
-greyScaleToStandardDef :: Image PixelF -> Image Pixel8
-greyScaleToStandardDef = pixelMap componentToLDR
-
-from16to8 :: ( PixelBaseComponent source ~ Word16
-             , PixelBaseComponent dest ~ Word8 )
-          => Image source -> Image dest
-from16to8 Image { imageWidth = w, imageHeight = h
-                , imageData = arr } = Image w h transformed
-   where transformed = V.map toWord8 arr
-         toWord8 v = fromIntegral (v `unsafeShiftR` 8)
-
-from16toFloat :: ( PixelBaseComponent source ~ Word16
-                 , PixelBaseComponent dest ~ Float )
-          => Image source -> Image dest
-from16toFloat Image { imageWidth = w, imageHeight = h
-                    , imageData = arr } = Image w h transformed
-   where transformed = V.map toWord8 arr
-         toWord8 v = fromIntegral v / 65536.0
-
--- | This function will try to do anything to encode an image
--- as RADIANCE, make all color conversion and such. Equivalent
--- of 'decodeImage' for radiance encoding
-imageToRadiance :: DynamicImage -> L.ByteString
-imageToRadiance (ImageCMYK8 img) =
-    imageToRadiance . ImageRGB8 $ convertImage img
-imageToRadiance (ImageCMYK16 img) =
-    imageToRadiance . ImageRGB16 $ convertImage img
-imageToRadiance (ImageYCbCr8 img) =
-    imageToRadiance . ImageRGB8 $ convertImage img
-imageToRadiance (ImageRGB8   img) =
-    imageToRadiance . ImageRGBF $ promoteImage img
-imageToRadiance (ImageRGBF   img) = encodeHDR img
-imageToRadiance (ImageRGBA8  img) =
-    imageToRadiance . ImageRGBF . promoteImage $ dropAlphaLayer img
-imageToRadiance (ImageY8     img) =
-    imageToRadiance . ImageRGB8 $ promoteImage img
-imageToRadiance (ImageYF     img) =
-    imageToRadiance . ImageRGBF $ promoteImage img
-imageToRadiance (ImageYA8    img) =
-    imageToRadiance . ImageRGB8 . promoteImage $ dropAlphaLayer img
-imageToRadiance (ImageY16    img) =
-  imageToRadiance . ImageRGBF $ pixelMap toRgbf img
-    where toRgbf v = PixelRGBF val val val
-            where val = fromIntegral v / 65536.0
-
-imageToRadiance (ImageYA16   img) =
-  imageToRadiance . ImageRGBF $ pixelMap toRgbf img
-    where toRgbf (PixelYA16 v _) = PixelRGBF val val val
-            where val = fromIntegral v / 65536.0
-imageToRadiance (ImageRGB16  img) =
-    imageToRadiance . ImageRGBF $ from16toFloat img
-imageToRadiance (ImageRGBA16 img) =
-    imageToRadiance . ImageRGBF $ pixelMap toRgbf img
-    where toRgbf (PixelRGBA16 r g b _) = PixelRGBF (f r) (f g) (f b)
-            where f v = fromIntegral v / 65536.0
-
--- | This function will try to do anything to encode an image
--- as JPEG, make all color conversion and such. Equivalent
--- of 'decodeImage' for jpeg encoding
-imageToJpg :: Int -> DynamicImage -> L.ByteString
-imageToJpg quality dynImage =
-    let encodeAtQuality = encodeJpegAtQuality (fromIntegral quality)
-    in case dynImage of
-        ImageYCbCr8 img -> encodeAtQuality img
-        ImageCMYK8  img -> imageToJpg quality . ImageRGB8 $ convertImage img
-        ImageCMYK16 img -> imageToJpg quality . ImageRGB16 $ convertImage img
-        ImageRGB8   img -> encodeAtQuality (convertImage img)
-        ImageRGBF   img -> imageToJpg quality . ImageRGB8 $ toStandardDef img
-        ImageRGBA8  img -> encodeAtQuality (convertImage $ dropAlphaLayer img)
-        ImageYF     img -> imageToJpg quality . ImageY8 $ greyScaleToStandardDef img
-        ImageY8     img -> encodeAtQuality . convertImage
-                                           $ (promoteImage img :: Image PixelRGB8)
-        ImageYA8    img -> encodeAtQuality $
-                            convertImage (promoteImage $ dropAlphaLayer img :: Image PixelRGB8)
-        ImageY16    img -> imageToJpg quality . ImageY8 $ from16to8 img
-        ImageYA16   img -> imageToJpg quality . ImageYA8 $ from16to8 img
-        ImageRGB16  img -> imageToJpg quality . ImageRGB8 $ from16to8 img
-        ImageRGBA16 img -> imageToJpg quality . ImageRGBA8 $ from16to8 img
-
--- | This function will try to do anything to encode an image
--- as PNG, make all color conversion and such. Equivalent
--- of 'decodeImage' for PNG encoding
-imageToPng :: DynamicImage -> L.ByteString
-imageToPng (ImageYCbCr8 img) = encodePng (convertImage img :: Image PixelRGB8)
-imageToPng (ImageCMYK8 img)  = encodePng (convertImage img :: Image PixelRGB8)
-imageToPng (ImageCMYK16 img) = encodePng (convertImage img :: Image PixelRGB16)
-imageToPng (ImageRGB8   img) = encodePng img
-imageToPng (ImageRGBF   img) = encodePng $ toStandardDef img
-imageToPng (ImageRGBA8  img) = encodePng img
-imageToPng (ImageY8     img) = encodePng img
-imageToPng (ImageYF     img) = encodePng $ greyScaleToStandardDef img
-imageToPng (ImageYA8    img) = encodePng img
-imageToPng (ImageY16    img) = encodePng img
-imageToPng (ImageYA16   img) = encodePng img
-imageToPng (ImageRGB16  img) = encodePng img
-imageToPng (ImageRGBA16 img) = encodePng img
-
--- | This function will try to do anything to encode an image
--- as a Tiff, make all color conversion and such. Equivalent
--- of 'decodeImage' for Tiff encoding
-imageToTiff :: DynamicImage -> L.ByteString
-imageToTiff (ImageYCbCr8 img) = encodeTiff img
-imageToTiff (ImageCMYK8 img)  = encodeTiff img
-imageToTiff (ImageCMYK16 img) = encodeTiff img
-imageToTiff (ImageRGB8   img) = encodeTiff img
-imageToTiff (ImageRGBF   img) = encodeTiff $ toStandardDef img
-imageToTiff (ImageRGBA8  img) = encodeTiff img
-imageToTiff (ImageY8     img) = encodeTiff img
-imageToTiff (ImageYF     img) = encodeTiff $ greyScaleToStandardDef img
-imageToTiff (ImageYA8    img) = encodeTiff $ dropAlphaLayer img
-imageToTiff (ImageY16    img) = encodeTiff img
-imageToTiff (ImageYA16   img) = encodeTiff $ dropAlphaLayer img
-imageToTiff (ImageRGB16  img) = encodeTiff img
-imageToTiff (ImageRGBA16 img) = encodeTiff img
-
--- | This function will try to do anything to encode an image
--- as bitmap, make all color conversion and such. Equivalent
--- of 'decodeImage' for Bitmap encoding
-imageToBitmap :: DynamicImage -> L.ByteString
-imageToBitmap (ImageYCbCr8 img) = encodeBitmap (convertImage img :: Image PixelRGB8)
-imageToBitmap (ImageCMYK8  img) = encodeBitmap (convertImage img :: Image PixelRGB8)
-imageToBitmap (ImageCMYK16 img) = imageToBitmap . ImageRGB16 $ convertImage img
-imageToBitmap (ImageRGBF   img) = encodeBitmap $ toStandardDef img
-imageToBitmap (ImageRGB8   img) = encodeBitmap img
-imageToBitmap (ImageRGBA8  img) = encodeBitmap img
-imageToBitmap (ImageY8     img) = encodeBitmap img
-imageToBitmap (ImageYF     img) = encodeBitmap $ greyScaleToStandardDef img
-imageToBitmap (ImageYA8    img) = encodeBitmap (promoteImage img :: Image PixelRGBA8)
-imageToBitmap (ImageY16    img) = imageToBitmap . ImageY8 $ from16to8 img
-imageToBitmap (ImageYA16   img) = imageToBitmap . ImageYA8 $ from16to8 img
-imageToBitmap (ImageRGB16  img) = imageToBitmap . ImageRGB8 $ from16to8 img
-imageToBitmap (ImageRGBA16 img) = imageToBitmap . ImageRGBA8 $ from16to8 img
-

@@ -1,1285 +0,0 @@-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE ScopedTypeVariables #-}
--- | Module implementing TIFF decoding.
---
--- Supported compression schemes :
---
---   * Uncompressed
---
---   * PackBits
---
---   * LZW
---
--- Supported bit depth :
---
---   * 2 bits
---
---   * 4 bits
---
---   * 8 bits
---
---   * 16 bits
---
-module Codec.Picture.Tiff( decodeTiff, TiffSaveable, encodeTiff, writeTiff ) where
-
-import Control.Applicative( (<$>), (<*>), pure )
-import Control.Monad( when, replicateM, foldM_ )
-import Control.Monad.ST( ST, runST )
-import Control.Monad.Writer.Strict( execWriter, tell, Writer )
-import Data.Int( Int8 )
-import Data.Word( Word8, Word16 )
-import Data.Bits( (.&.), (.|.), unsafeShiftL, unsafeShiftR )
-import Data.Binary( Binary( .. ) )
-import Data.Binary.Get( Get
-                      , getWord16le, getWord16be
-                      , getWord32le, getWord32be
-                      , bytesRead
-                      , skip
-                      , getByteString
-                      )
-import Data.Binary.Put( Put, runPut
-                      , putWord16le, putWord16be
-                      , putWord32le, putWord32be
-                      , putByteString
-                      )
-
-import Data.List( sortBy, mapAccumL )
-import qualified Data.Vector as V
-import qualified Data.Vector.Storable as VS
-import qualified Data.Vector.Storable.Mutable as M
-import Data.Word( Word32 )
-import qualified Data.ByteString as B
-import qualified Data.ByteString.Lazy as Lb
-import qualified Data.ByteString.Unsafe as BU
-
-import Foreign.Storable( sizeOf )
-
-import Codec.Picture.InternalHelper
-import Codec.Picture.BitWriter
-import Codec.Picture.Types
-import Codec.Picture.Gif.LZW
-import Codec.Picture.VectorByteConversion( toByteString )
-
-data Endianness = EndianLittle
-                | EndianBig
-                deriving (Eq, Show)
-
-instance Binary Endianness where
-    put EndianLittle = putWord16le 0x4949
-    put EndianBig = putWord16le 0x4D4D
-
-    get = do
-        tag <- getWord16le
-        case tag of
-            0x4949 -> return EndianLittle
-            0x4D4D -> return EndianBig
-            _ -> fail "Invalid endian tag value"
-
--- | Because having a polymorphic get with endianness is to nice
--- to pass on, introducing this helper type class, which is just
--- a superset of Binary, but formalising a parameter passing
--- into it.
-class BinaryParam a b where
-    getP :: a -> Get b
-    putP :: a -> b -> Put
-
-data TiffHeader = TiffHeader
-    { hdrEndianness :: !Endianness
-    , hdrOffset     :: {-# UNPACK #-} !Word32
-    }
-    deriving (Eq, Show)
-
-instance BinaryParam Endianness Word16 where
-    putP EndianLittle = putWord16le
-    putP EndianBig = putWord16be
-
-    getP EndianLittle = getWord16le
-    getP EndianBig = getWord16be
-
-instance BinaryParam Endianness Word32 where
-    putP EndianLittle = putWord32le
-    putP EndianBig = putWord32be
-
-    getP EndianLittle = getWord32le
-    getP EndianBig = getWord32be
-
-instance Binary TiffHeader where
-    put hdr = do
-        let endian = hdrEndianness hdr
-        put endian
-        putP endian (42 :: Word16)
-        putP endian $ hdrOffset hdr
-
-    get = do
-        endian <- get
-        magic <- getP endian
-        let magicValue = 42 :: Word16
-        when (magic /= magicValue)
-             (fail "Invalid TIFF magic number")
-        TiffHeader endian <$> getP endian
-
-data TiffPlanarConfiguration =
-      PlanarConfigContig    -- = 1
-    | PlanarConfigSeparate  -- = 2
-
-planarConfgOfConstant :: Word32 -> Get TiffPlanarConfiguration
-planarConfgOfConstant 0 = pure PlanarConfigContig
-planarConfgOfConstant 1 = pure PlanarConfigContig
-planarConfgOfConstant 2 = pure PlanarConfigSeparate
-planarConfgOfConstant v = fail $ "Unknown planar constant (" ++ show v ++ ")"
-
-constantToPlaneConfiguration :: TiffPlanarConfiguration -> Word16
-constantToPlaneConfiguration PlanarConfigContig = 1
-constantToPlaneConfiguration PlanarConfigSeparate = 2
-
-data TiffCompression =
-      CompressionNone           -- 1
-    | CompressionModifiedRLE    -- 2
-    | CompressionLZW            -- 5
-    | CompressionJPEG           -- 6
-    | CompressionPackBit        -- 32273
-
-data IfdType = TypeByte
-             | TypeAscii
-             | TypeShort
-             | TypeLong
-             | TypeRational
-             | TypeSByte
-             | TypeUndefined
-             | TypeSignedShort
-             | TypeSignedLong
-             | TypeSignedRational
-             | TypeFloat
-             | TypeDouble
-
-instance BinaryParam Endianness IfdType where
-    getP endianness = getP endianness >>= conv
-      where
-        conv :: Word16 -> Get IfdType
-        conv 1  = return TypeByte
-        conv 2  = return TypeAscii
-        conv 3  = return TypeShort
-        conv 4  = return TypeLong
-        conv 5  = return TypeRational
-        conv 6  = return TypeSByte
-        conv 7  = return TypeUndefined
-        conv 8  = return TypeSignedShort
-        conv 9  = return TypeSignedLong
-        conv 10 = return TypeSignedRational
-        conv 11 = return TypeFloat
-        conv 12 = return TypeDouble
-        conv _  = fail "Invalid TIF directory type"
-
-    putP endianness = putP endianness . conv
-      where
-        conv :: IfdType -> Word16
-        conv TypeByte = 1
-        conv TypeAscii = 2
-        conv TypeShort = 3
-        conv TypeLong = 4
-        conv TypeRational = 5
-        conv TypeSByte = 6
-        conv TypeUndefined = 7
-        conv TypeSignedShort = 8
-        conv TypeSignedLong = 9
-        conv TypeSignedRational = 10
-        conv TypeFloat = 11
-        conv TypeDouble = 12
-
-data TiffTag = TagPhotometricInterpretation
-             | TagCompression -- ^ Short type
-             | TagImageWidth  -- ^ Short or long type
-             | TagImageLength -- ^ Short or long type
-             | TagXResolution -- ^ Rational type
-             | TagYResolution -- ^ Rational type
-             | TagResolutionUnit --  ^ Short type
-             | TagRowPerStrip -- ^ Short or long type
-             | TagStripByteCounts -- ^ Short or long
-             | TagStripOffsets -- ^ Short or long
-             | TagBitsPerSample --  ^ Short
-             | TagColorMap -- ^ Short
-             | TagTileWidth
-             | TagTileLength
-             | TagTileOffset
-             | TagTileByteCount
-             | TagSamplesPerPixel -- ^ Short
-             | TagArtist
-             | TagDocumentName
-             | TagSoftware
-             | TagPlanarConfiguration -- ^ Short
-             | TagOrientation
-             | TagSampleFormat -- ^ Short
-             | TagInkSet
-             | TagSubfileType
-             | TagFillOrder
-             | TagYCbCrCoeff
-             | TagYCbCrSubsampling
-             | TagYCbCrPositioning
-             | TagReferenceBlackWhite
-             | TagXPosition
-             | TagYPosition
-             | TagExtraSample
-             | TagImageDescription
-
-             | TagJpegProc
-             | TagJPEGInterchangeFormat
-             | TagJPEGInterchangeFormatLength
-             | TagJPEGRestartInterval
-             | TagJPEGLosslessPredictors
-             | TagJPEGPointTransforms
-             | TagJPEGQTables
-             | TagJPEGDCTables
-             | TagJPEGACTables
-
-             | TagUnknown Word16
-             deriving (Eq, Show)
-
-tagOfWord16 :: Word16 -> TiffTag
-tagOfWord16 = aux
-  where aux 255 = TagSubfileType
-        aux 256 = TagImageWidth
-        aux 257 = TagImageLength
-        aux 258 = TagBitsPerSample
-        aux 259 = TagCompression
-        aux 262 = TagPhotometricInterpretation
-        aux 266 = TagFillOrder
-        aux 269 = TagDocumentName
-        aux 270 = TagImageDescription
-        aux 273 = TagStripOffsets
-        aux 274 = TagOrientation
-        aux 277 = TagSamplesPerPixel
-        aux 278 = TagRowPerStrip
-        aux 279 = TagStripByteCounts
-        aux 282 = TagXResolution
-        aux 283 = TagYResolution
-        aux 284 = TagPlanarConfiguration
-        aux 286 = TagXPosition
-        aux 287 = TagYPosition
-        aux 296 = TagResolutionUnit
-        aux 305 = TagSoftware
-        aux 315 = TagArtist
-        aux 320 = TagColorMap
-        aux 322 = TagTileWidth
-        aux 323 = TagTileLength
-        aux 324 = TagTileOffset
-        aux 325 = TagTileByteCount
-        aux 332 = TagInkSet
-        aux 338 = TagExtraSample
-        aux 339 = TagSampleFormat
-        aux 529 = TagYCbCrCoeff
-        aux 512 = TagJpegProc
-        aux 513 = TagJPEGInterchangeFormat
-        aux 514 = TagJPEGInterchangeFormatLength
-        aux 515 = TagJPEGRestartInterval
-        aux 517 = TagJPEGLosslessPredictors
-        aux 518 = TagJPEGPointTransforms
-        aux 519 = TagJPEGQTables
-        aux 520 = TagJPEGDCTables
-        aux 521 = TagJPEGACTables
-        aux 530 = TagYCbCrSubsampling
-        aux 531 = TagYCbCrPositioning
-        aux 532 = TagReferenceBlackWhite
-        aux v = TagUnknown v
-
-word16OfTag :: TiffTag -> Word16
-word16OfTag = aux
-  where aux TagSubfileType = 255
-        aux TagImageWidth = 256
-        aux TagImageLength = 257
-        aux TagBitsPerSample = 258
-        aux TagCompression = 259
-        aux TagPhotometricInterpretation = 262
-        aux TagFillOrder = 266
-        aux TagDocumentName = 269
-        aux TagImageDescription = 270
-        aux TagStripOffsets = 273
-        aux TagOrientation = 274
-        aux TagSamplesPerPixel = 277
-        aux TagRowPerStrip = 278
-        aux TagStripByteCounts = 279
-        aux TagXResolution = 282
-        aux TagYResolution = 283
-        aux TagPlanarConfiguration = 284
-        aux TagXPosition = 286
-        aux TagYPosition = 287
-        aux TagResolutionUnit = 296
-        aux TagSoftware = 305
-        aux TagArtist = 315
-        aux TagColorMap = 320
-        aux TagTileWidth = 322
-        aux TagTileLength = 323
-        aux TagTileOffset = 324
-        aux TagTileByteCount = 325
-        aux TagInkSet = 332
-        aux TagExtraSample = 338
-        aux TagSampleFormat = 339
-        aux TagYCbCrCoeff = 529
-        aux TagJpegProc = 512
-        aux TagJPEGInterchangeFormat = 513
-        aux TagJPEGInterchangeFormatLength = 514
-        aux TagJPEGRestartInterval = 515
-        aux TagJPEGLosslessPredictors = 517
-        aux TagJPEGPointTransforms = 518
-        aux TagJPEGQTables = 519
-        aux TagJPEGDCTables = 520
-        aux TagJPEGACTables = 521
-        aux TagYCbCrSubsampling = 530
-        aux TagYCbCrPositioning = 531
-        aux TagReferenceBlackWhite = 532
-        aux (TagUnknown v) = v
-
-instance BinaryParam Endianness TiffTag where
-  getP endianness = tagOfWord16 <$> getP endianness
-  putP endianness = putP endianness . word16OfTag
-
-data ExtendedDirectoryData =
-      ExtendedDataNone
-    | ExtendedDataAscii !B.ByteString
-    | ExtendedDataShort !(V.Vector Word16)
-    | ExtendedDataLong  !(V.Vector Word32)
-    deriving (Eq, Show)
-
-instance BinaryParam (Endianness, ImageFileDirectory) ExtendedDirectoryData where
-  putP (endianness, _) = dump
-    where
-      dump ExtendedDataNone = pure ()
-      dump (ExtendedDataAscii bstr) = putByteString bstr
-      dump (ExtendedDataShort shorts) = V.mapM_ (putP endianness) shorts
-      dump (ExtendedDataLong longs) = V.mapM_ (putP endianness) longs
-
-  getP (endianness, ifd) = fetcher ifd
-    where
-      align ImageFileDirectory { ifdOffset = offset } = do
-        readed <- bytesRead
-        skip . fromIntegral $ fromIntegral offset - readed
-
-      getE :: (BinaryParam Endianness a) => Get a
-      getE = getP endianness
-
-      getVec count = V.replicateM (fromIntegral count)
-
-      fetcher ImageFileDirectory { ifdType = TypeAscii, ifdCount = count } | count > 1 =
-          align ifd >> (ExtendedDataAscii <$> getByteString (fromIntegral count))
-      fetcher ImageFileDirectory { ifdType = TypeShort, ifdCount = 2, ifdOffset = ofs } =
-          pure . ExtendedDataShort $ V.fromListN 2 valList
-            where high = fromIntegral $ ofs `unsafeShiftR` 16
-                  low = fromIntegral $ ofs .&. 0xFFFF
-                  valList = case endianness of
-                    EndianLittle -> [low, high]
-                    EndianBig -> [high, low]
-      fetcher ImageFileDirectory { ifdType = TypeShort, ifdCount = count } | count > 2 =
-          align ifd >> (ExtendedDataShort <$> getVec count getE)
-      fetcher ImageFileDirectory { ifdType = TypeLong, ifdCount = count } | count > 1 =
-          align ifd >> (ExtendedDataLong <$> getVec count getE)
-      fetcher _ = pure ExtendedDataNone
-
-data TiffSampleFormat =
-      TiffSampleUint
-    | TiffSampleInt
-    | TiffSampleDouble
-    | TiffSampleUnknown
-    deriving Eq
-
-unpackSampleFormat :: Word32 -> Get TiffSampleFormat
-unpackSampleFormat = aux
-  where
-    aux 1 = pure TiffSampleUint
-    aux 2 = pure TiffSampleInt
-    aux 3 = pure TiffSampleDouble
-    aux 4 = pure TiffSampleUnknown
-    aux v = fail $ "Undefined data format (" ++ show v ++ ")"
-
-data ImageFileDirectory = ImageFileDirectory
-    { ifdIdentifier :: !TiffTag
-    , ifdType       :: !IfdType
-    , ifdCount      :: !Word32
-    , ifdOffset     :: !Word32
-    , ifdExtended   :: !ExtendedDirectoryData
-    }
-
-unLong :: String -> ExtendedDirectoryData -> Get (V.Vector Word32)
-unLong _ (ExtendedDataShort v) = pure $ V.map fromIntegral v
-unLong _ (ExtendedDataLong v) = pure v
-unLong errMessage _ = fail errMessage
-
-cleanImageFileDirectory :: Endianness -> ImageFileDirectory -> ImageFileDirectory
-cleanImageFileDirectory EndianBig ifd@(ImageFileDirectory { ifdCount = 1 }) = aux $ ifdType ifd
-    where aux TypeShort = ifd { ifdOffset = ifdOffset ifd `unsafeShiftR` 16 }
-          aux _ = ifd
-cleanImageFileDirectory _ ifd = ifd
-
-instance BinaryParam Endianness ImageFileDirectory where
-  getP endianness =
-    ImageFileDirectory <$> getE <*> getE <*> getE <*> getE
-                       <*> pure ExtendedDataNone
-        where getE :: (BinaryParam Endianness a) => Get a
-              getE = getP endianness
-
-  putP endianness ifd =do
-    let putE :: (BinaryParam Endianness a) => a -> Put
-        putE = putP endianness
-    putE $ ifdIdentifier ifd
-    putE $ ifdType ifd
-    putE $ ifdCount ifd
-    putE $ ifdOffset ifd
-
-instance BinaryParam Endianness [ImageFileDirectory] where
-  getP endianness = do
-    count <- getP endianness :: Get Word16
-    rez <- replicateM (fromIntegral count) $ getP endianness
-    _ <- getP endianness :: Get Word32
-    pure rez
-
-  putP endianness lst = do
-    let count = fromIntegral $ length lst :: Word16
-    putP endianness count
-    mapM_ (putP endianness) lst
-    putP endianness (0 :: Word32)
-
-fetchExtended :: Endianness -> [ImageFileDirectory] -> Get [ImageFileDirectory]
-fetchExtended endian = mapM $ \ifd -> do
-        v <- getP (endian, ifd)
-        pure $ ifd { ifdExtended = v }
-
-findIFD :: String -> TiffTag -> [ImageFileDirectory]
-        -> Get ImageFileDirectory
-findIFD errorMessage tag lst =
-    case [v | v <- lst, ifdIdentifier v == tag] of
-        [] -> fail errorMessage
-        (x:_) -> pure x
-
-findPalette :: [ImageFileDirectory] -> Get (Maybe (Image PixelRGB16))
-findPalette ifds =
-    case [v | v <- ifds, ifdIdentifier v == TagColorMap] of
-        (ImageFileDirectory { ifdExtended = ExtendedDataShort vec }:_) ->
-            pure . Just . Image pixelCount 1 $ VS.generate (V.length vec) axx
-                where pixelCount = V.length vec `div` 3
-                      axx v = vec `V.unsafeIndex` (idx + color * pixelCount)
-                          where (idx, color) = v `divMod` 3
-
-        _ -> pure Nothing
-
-findIFDData :: String -> TiffTag -> [ImageFileDirectory] -> Get Word32
-findIFDData msg tag lst = ifdOffset <$> findIFD msg tag lst
-
-findIFDDefaultData :: Word32 -> TiffTag -> [ImageFileDirectory] -> Get Word32
-findIFDDefaultData d tag lst =
-    case [v | v <- lst, ifdIdentifier v == tag] of
-        [] -> pure d
-        (x:_) -> pure $ ifdOffset x
-
-findIFDExt :: String -> TiffTag -> [ImageFileDirectory] -> Get ExtendedDirectoryData
-findIFDExt msg tag lst = do
-    val <- findIFD msg tag lst
-    case val of
-      ImageFileDirectory
-        { ifdCount = 1, ifdOffset = ofs, ifdType = TypeShort } ->
-               pure . ExtendedDataShort . V.singleton $ fromIntegral ofs
-      ImageFileDirectory
-        { ifdCount = 1, ifdOffset = ofs, ifdType = TypeLong } ->
-               pure . ExtendedDataLong . V.singleton $ fromIntegral ofs
-      ImageFileDirectory { ifdExtended = v } -> pure v
-
-
-findIFDExtDefaultData :: [Word32] -> TiffTag -> [ImageFileDirectory]
-                      -> Get [Word32]
-findIFDExtDefaultData d tag lst =
-    case [v | v <- lst, ifdIdentifier v == tag] of
-        [] -> pure d
-        (ImageFileDirectory { ifdExtended = ExtendedDataNone }:_) -> return d
-        (x:_) -> V.toList <$> unLong errorMessage (ifdExtended x)
-            where errorMessage =
-                    "Can't parse tag " ++ show tag ++ " " ++ show (ifdExtended x)
-
--- It's temporary, remove once tiff decoding is better
--- handled.
-{-  
-instance Show (Image PixelRGB16) where
-    show _ = "Image PixelRGB16"
--}
-
-data TiffInfo = TiffInfo
-    { tiffHeader             :: TiffHeader
-    , tiffWidth              :: Word32
-    , tiffHeight             :: Word32
-    , tiffColorspace         :: TiffColorspace
-    , tiffSampleCount        :: Word32
-    , tiffRowPerStrip        :: Word32
-    , tiffPlaneConfiguration :: TiffPlanarConfiguration
-    , tiffSampleFormat       :: [TiffSampleFormat]
-    , tiffBitsPerSample      :: V.Vector Word32
-    , tiffCompression        :: TiffCompression
-    , tiffStripSize          :: V.Vector Word32
-    , tiffOffsets            :: V.Vector Word32
-    , tiffPalette            :: Maybe (Image PixelRGB16)
-    , tiffYCbCrSubsampling   :: V.Vector Word32
-    }
-
-data TiffColorspace =
-      TiffMonochromeWhite0 -- ^ 0
-    | TiffMonochrome       -- ^ 1
-    | TiffRGB              -- ^ 2
-    | TiffPaleted          -- ^ 3
-    | TiffTransparencyMask -- ^ 4
-    | TiffCMYK             -- ^ 5
-    | TiffYCbCr            -- ^ 6
-    | TiffCIELab           -- ^ 8
-
-packPhotometricInterpretation :: TiffColorspace -> Word16
-packPhotometricInterpretation = aux
-  where
-    aux TiffMonochromeWhite0 = 0
-    aux TiffMonochrome       = 1
-    aux TiffRGB              = 2
-    aux TiffPaleted          = 3
-    aux TiffTransparencyMask = 4
-    aux TiffCMYK             = 5
-    aux TiffYCbCr            = 6
-    aux TiffCIELab           = 8
-
-unpackPhotometricInterpretation :: Word32 -> Get TiffColorspace
-unpackPhotometricInterpretation = aux
-  where aux 0 = pure TiffMonochromeWhite0
-        aux 1 = pure TiffMonochrome
-        aux 2 = pure TiffRGB
-        aux 3 = pure TiffPaleted
-        aux 4 = pure TiffTransparencyMask
-        aux 5 = pure TiffCMYK
-        aux 6 = pure TiffYCbCr
-        aux 8 = pure TiffCIELab
-        aux v = fail $ "Unrecognized color space " ++ show v
-
-unPackCompression :: Word32 -> Get TiffCompression
-unPackCompression = aux
-  where
-    aux 0 = pure CompressionNone
-    aux 1 = pure CompressionNone
-    aux 2 = pure CompressionModifiedRLE
-    aux 5 = pure CompressionLZW
-    aux 6 = pure CompressionJPEG
-    aux 32773 = pure CompressionPackBit
-    aux v = fail $ "Unknown compression scheme " ++ show v
-
-packCompression :: TiffCompression -> Word16
-packCompression = aux
-  where
-    aux CompressionNone        = 1
-    aux CompressionModifiedRLE = 2
-    aux CompressionLZW         = 5
-    aux CompressionJPEG        = 6
-    aux CompressionPackBit     = 32773
-
-copyByteString :: B.ByteString -> M.STVector s Word8 -> Int -> Int -> (Word32, Word32)
-               -> ST s Int
-copyByteString str vec stride startWrite (from, count) = inner startWrite fromi
-  where fromi = fromIntegral from
-        maxi = fromi + fromIntegral count
-
-        inner writeIdx i | i >= maxi = pure writeIdx
-        inner writeIdx i = do
-            let v = str `BU.unsafeIndex` i
-            (vec `M.unsafeWrite` writeIdx) v
-            inner (writeIdx + stride) $ i + 1
-
-unpackPackBit :: B.ByteString -> M.STVector s Word8 -> Int -> Int
-              -> (Word32, Word32)
-              -> ST s Int
-unpackPackBit str outVec stride writeIndex (offset, size) = loop fromi writeIndex
-  where fromi = fromIntegral offset
-        maxi = fromi + fromIntegral size
-
-        replicateByte writeIdx _     0 = pure writeIdx
-        replicateByte writeIdx v count = do
-            (outVec `M.unsafeWrite` writeIdx) v
-            replicateByte (writeIdx + stride) v $ count - 1
-
-        loop i writeIdx | i >= maxi = pure writeIdx
-        loop i writeIdx = choice
-          {-where v = fromIntegral (str `BU.unsafeIndex` i) :: Int8-}
-          where v = fromIntegral (str `B.index` i) :: Int8
-
-                choice
-                    -- data
-                    | 0    <= v = do
-                        copyByteString str outVec stride writeIdx
-                                        (fromIntegral $ i + 1, fromIntegral v + 1)
-                            >>= loop (i + 2 + fromIntegral v)
-                    -- run
-                    | -127 <= v = do
-                        {-let nextByte = str `BU.unsafeIndex` (i + 1)-}
-                        let nextByte = str `B.index` (i + 1)
-                            count = negate (fromIntegral v) + 1 :: Int
-                        replicateByte writeIdx nextByte count
-                            >>= loop (i + 2)
-
-                    -- noop
-                    | otherwise = loop writeIdx $ i + 1
-
-uncompressAt :: TiffCompression
-             -> B.ByteString -> M.STVector s Word8 -> Int -> Int -> (Word32, Word32)
-             -> ST s Int
-uncompressAt CompressionNone = copyByteString
-uncompressAt CompressionPackBit = unpackPackBit
-uncompressAt CompressionLZW =  \str outVec _stride writeIndex (offset, size) -> do
-    let toDecode = B.take (fromIntegral size) $ B.drop (fromIntegral offset) str
-    runBoolReader $ decodeLzwTiff toDecode outVec writeIndex
-    return 0
-uncompressAt _ = error "Unhandled compression"
-
-class Unpackable a where
-    type StorageType a :: *
-
-    outAlloc :: a -> Int -> ST s (M.STVector s (StorageType a))
-
-    -- | Final image and size, return offset and vector
-    allocTempBuffer :: a  -> M.STVector s (StorageType a) -> Int
-                    -> ST s (M.STVector s Word8)
-
-    offsetStride :: a -> Int -> Int -> (Int, Int)
-
-    mergeBackTempBuffer :: a    -- ^ Type witness, just for the type checker.
-                        -> Endianness
-                        -> M.STVector s Word8 -- ^ Temporary buffer handling decompression.
-                        -> Int -- ^ Line size in pixels
-                        -> Int  -- ^ Write index, in bytes
-                        -> Word32  -- ^ size, in bytes
-                        -> Int  -- ^ Stride
-                        -> M.STVector s (StorageType a) -- ^ Final buffer
-                        -> ST s ()
-
--- | The Word8 instance is just a passthrough, to avoid
--- copying memory twice
-instance Unpackable Word8 where
-  type StorageType Word8 = Word8
-
-  offsetStride _ i stride = (i, stride)
-  allocTempBuffer _ buff _ = pure buff
-  mergeBackTempBuffer _ _ _ _ _ _ _ _ = pure ()
-  outAlloc _ count = M.replicate count 0 -- M.new
-
-instance Unpackable Word16 where
-  type StorageType Word16 = Word16
-
-  offsetStride _ _ _ = (0, 1)
-  outAlloc _ = M.new
-  allocTempBuffer _ _ s = M.new $ s * 2
-  mergeBackTempBuffer _ EndianLittle tempVec _ index size stride outVec =
-        looperLe index 0
-    where looperLe _ readIndex | readIndex >= fromIntegral size = pure ()
-          looperLe writeIndex readIndex = do
-              v1 <- tempVec `M.read` readIndex
-              v2 <- tempVec `M.read` (readIndex + 1)
-              let finalValue =
-                    (fromIntegral v2 `unsafeShiftL` 8) .|. fromIntegral v1
-              (outVec `M.write` writeIndex) finalValue
-
-              looperLe (writeIndex + stride) (readIndex + 2)
-  mergeBackTempBuffer _ EndianBig tempVec _ index size stride outVec =
-         looperBe index 0
-    where looperBe _ readIndex | readIndex >= fromIntegral size = pure ()
-          looperBe writeIndex readIndex = do
-              v1 <- tempVec `M.read` readIndex
-              v2 <- tempVec `M.read` (readIndex + 1)
-              let finalValue =
-                    (fromIntegral v1 `unsafeShiftL` 8) .|. fromIntegral v2
-              (outVec `M.write` writeIndex) finalValue
-
-              looperBe (writeIndex + stride) (readIndex + 2)
-
-instance Unpackable Word32 where
-  type StorageType Word32 = Word32
-
-  offsetStride _ _ _ = (0, 1)
-  outAlloc _ = M.new
-  allocTempBuffer _ _ s = M.new $ s * 4
-  mergeBackTempBuffer _ EndianLittle tempVec _ index size stride outVec =
-        looperLe index 0
-    where looperLe _ readIndex | readIndex >= fromIntegral size = pure ()
-          looperLe writeIndex readIndex = do
-              v1 <- tempVec `M.read` readIndex
-              v2 <- tempVec `M.read` (readIndex + 1)
-              v3 <- tempVec `M.read` (readIndex + 2)
-              v4 <- tempVec `M.read` (readIndex + 3)
-              let finalValue =
-                    (fromIntegral v4 `unsafeShiftL` 24) .|.
-                    (fromIntegral v3 `unsafeShiftL` 16) .|.
-                    (fromIntegral v2 `unsafeShiftL` 8) .|.
-                    fromIntegral v1
-              (outVec `M.write` writeIndex) finalValue
-
-              looperLe (writeIndex + stride) (readIndex + 4)
-  mergeBackTempBuffer _ EndianBig tempVec _ index size stride outVec =
-         looperBe index 0
-    where looperBe _ readIndex | readIndex >= fromIntegral size = pure ()
-          looperBe writeIndex readIndex = do
-              v1 <- tempVec `M.read` readIndex
-              v2 <- tempVec `M.read` (readIndex + 1)
-              v3 <- tempVec `M.read` (readIndex + 2)
-              v4 <- tempVec `M.read` (readIndex + 3)
-              let finalValue =
-                    (fromIntegral v1 `unsafeShiftL` 24) .|.
-                    (fromIntegral v2 `unsafeShiftL` 16) .|.
-                    (fromIntegral v3 `unsafeShiftL` 8) .|.
-                    fromIntegral v4
-              (outVec `M.write` writeIndex) finalValue
-
-              looperBe (writeIndex + stride) (readIndex + 4)
-
-data Pack4 = Pack4
-
-instance Unpackable Pack4 where
-  type StorageType Pack4 = Word8
-  allocTempBuffer _ _ = M.new
-  offsetStride _ _ _ = (0, 1)
-  outAlloc _ = M.new
-  mergeBackTempBuffer _ _ tempVec lineSize index size stride outVec =
-        inner 0 index pxCount
-    where pxCount = lineSize `div` stride
-
-          maxWrite = M.length outVec
-          inner readIdx writeIdx _
-                | readIdx >= fromIntegral size || writeIdx >= maxWrite = pure ()
-          inner readIdx writeIdx line
-                | line <= 0 = inner readIdx (writeIdx + line * stride) pxCount
-          inner readIdx writeIdx line = do
-            v <- tempVec `M.read` readIdx
-            let high = (v `unsafeShiftR` 4) .&. 0xF
-                low = v .&. 0xF
-            (outVec `M.write` writeIdx) high
-            when (writeIdx + stride < maxWrite) $
-                 (outVec `M.write` (writeIdx + stride)) low
-
-            inner (readIdx + 1) (writeIdx + 2 * stride) (line - 2)
-
-data Pack2 = Pack2
-
-instance Unpackable Pack2 where
-  type StorageType Pack2 = Word8
-  allocTempBuffer _ _ = M.new
-  offsetStride _ _ _ = (0, 1)
-  outAlloc _ = M.new
-  mergeBackTempBuffer _ _ tempVec lineSize index size stride outVec =
-        inner 0 index pxCount
-    where pxCount = lineSize `div` stride
-
-          maxWrite = M.length outVec
-          inner readIdx writeIdx _
-                | readIdx >= fromIntegral size || writeIdx >= maxWrite = pure ()
-          inner readIdx writeIdx line
-                | line <= 0 = inner readIdx (writeIdx + line * stride) pxCount
-          inner readIdx writeIdx line = do
-            v <- tempVec `M.read` readIdx
-            let v0 = (v `unsafeShiftR` 6) .&. 0x3
-                v1 = (v `unsafeShiftR` 4) .&. 0x3
-                v2 = (v `unsafeShiftR` 2) .&. 0x3
-                v3 = v .&. 0x3
-
-            (outVec `M.write` writeIdx) v0
-            when (writeIdx + 1 * stride < maxWrite) $
-                 (outVec `M.write` (writeIdx + stride)) v1
-
-            when (writeIdx + 2 * stride < maxWrite) $
-                 (outVec `M.write` (writeIdx + stride * 2)) v2
-
-            when (writeIdx + 3 * stride < maxWrite) $
-                 (outVec `M.write` (writeIdx + stride * 3)) v3
-
-            inner (readIdx + 1) (writeIdx + 4 * stride) (line - 4)
-
-data Pack12 = Pack12
-
-instance Unpackable Pack12 where
-  type StorageType Pack12 = Word16
-  allocTempBuffer _ _ = M.new
-  offsetStride _ _ _ = (0, 1)
-  outAlloc _ = M.new
-  mergeBackTempBuffer _ _ tempVec lineSize index size stride outVec =
-        inner 0 index pxCount
-    where pxCount = lineSize `div` stride
-
-          maxWrite = M.length outVec
-          inner readIdx writeIdx _
-                | readIdx >= fromIntegral size || writeIdx >= maxWrite = pure ()
-          inner readIdx writeIdx line
-                | line <= 0 = inner readIdx (writeIdx + line * stride) pxCount
-          inner readIdx writeIdx line = do
-            v0 <- tempVec `M.read` readIdx
-            v1 <- if readIdx + 1 < fromIntegral size
-                then tempVec `M.read` (readIdx + 1)
-                else pure 0
-            v2 <- if readIdx + 2 < fromIntegral size
-                then tempVec `M.read` (readIdx + 2)
-                else pure 0
-
-            let high0 = fromIntegral v0 `unsafeShiftL` 4
-                low0 = (fromIntegral v1 `unsafeShiftR` 4) .&. 0xF
-
-                p0 = high0 .|. low0
-
-                high1 = (fromIntegral v1 .&. 0xF) `unsafeShiftL` 8
-                low1 = fromIntegral v2
-                p1 = high1 .|. low1
-
-            (outVec `M.write` writeIdx) p0
-            when (writeIdx + 1 * stride < maxWrite) $
-                 (outVec `M.write` (writeIdx + stride)) p1
-
-            inner (readIdx + 3) (writeIdx + 2 * stride) (line - 2)
-
-data YCbCrSubsampling = YCbCrSubsampling
-    { ycbcrWidth        :: !Int
-    , ycbcrHeight       :: !Int
-    , ycbcrImageWidth   :: !Int
-    , ycbcrStripHeight  :: !Int
-    }
-
-instance Unpackable YCbCrSubsampling where
-  type StorageType YCbCrSubsampling = Word8
-
-  offsetStride _ _ _ = (0, 1)
-  outAlloc _ = M.new
-  allocTempBuffer _ _ = M.new
-  mergeBackTempBuffer subSampling _ tempVec _ index size _ outVec =
-      foldM_ unpacker 0 [(bx, by) | by <- [0, h .. lineCount - 1]
-                                  , bx <- [0, w .. imgWidth - 1]]
-    where w = ycbcrWidth subSampling
-          h = ycbcrHeight subSampling
-          imgWidth = ycbcrImageWidth subSampling
-          lineCount = ycbcrStripHeight subSampling
-
-          lumaCount = w * h
-          blockSize = lumaCount + 2
-
-          maxOut = M.length outVec
-
-          unpacker readIdx _ | readIdx >= fromIntegral size * 3 = pure readIdx
-          unpacker readIdx (bx, by) = do
-              cb <- tempVec `M.read` (readIdx + lumaCount)
-              cr <- tempVec `M.read` (readIdx + lumaCount + 1)
-
-              let pixelIndices =
-                        [index + ((by + y) * imgWidth + bx + x) * 3 | y <- [0 .. h - 1], x <- [0 .. w - 1]]
-
-                  writer readIndex writeIdx | writeIdx + 3 > maxOut = pure readIndex
-                  writer readIndex writeIdx = do
-                    y <- tempVec `M.read` readIndex
-                    (outVec `M.write` writeIdx) y
-                    (outVec `M.write` (writeIdx + 1)) cb
-                    (outVec `M.write` (writeIdx + 2)) cr
-                    return $ readIndex + 1
-
-              foldM_ writer readIdx pixelIndices
-
-              return $ readIdx + blockSize
-
-gatherStrips :: ( Unpackable comp
-                , Pixel pixel
-                , StorageType comp ~ PixelBaseComponent pixel
-                )
-             => comp -> B.ByteString -> TiffInfo -> Image pixel
-gatherStrips comp str nfo = runST $ do
-  let width = fromIntegral $ tiffWidth nfo
-      height = fromIntegral $ tiffHeight nfo
-      sampleCount = if tiffSampleCount nfo /= 0
-        then fromIntegral $ tiffSampleCount nfo
-        else V.length $ tiffBitsPerSample nfo
-
-      rowPerStrip = fromIntegral $ tiffRowPerStrip nfo
-      endianness = hdrEndianness $ tiffHeader nfo
-
-      stripCount = V.length $ tiffOffsets nfo
-      compression = tiffCompression nfo
-
-  outVec <- outAlloc comp $ width * height * sampleCount
-  tempVec <- allocTempBuffer comp outVec
-                        (rowPerStrip * width * sampleCount)
-
-  let mutableImage = MutableImage
-                   { mutableImageWidth = fromIntegral width
-                   , mutableImageHeight = fromIntegral height
-                   , mutableImageData = outVec
-                   }
-
-  case tiffPlaneConfiguration nfo of
-    PlanarConfigContig -> V.mapM_ unpacker sizes
-        where unpacker (idx, offset, size) = do
-                  let (writeIdx, tempStride)  = offsetStride comp idx 1
-                  _ <- uncompressAt compression str tempVec tempStride
-                                    writeIdx (offset, size)
-                  mergeBackTempBuffer comp endianness tempVec (width * sampleCount)
-                                      idx size 1 outVec
-
-              startWriteOffset =
-                  V.generate stripCount(width * rowPerStrip * sampleCount *)
-
-              sizes = V.zip3 startWriteOffset (tiffOffsets nfo) (tiffStripSize nfo)
-
-    PlanarConfigSeparate -> V.mapM_ unpacker sizes
-        where unpacker (idx, offset, size) = do
-                  let (writeIdx, tempStride) = offsetStride comp idx stride
-                  _ <- uncompressAt compression str tempVec tempStride
-                                    writeIdx (offset, size)
-                  mergeBackTempBuffer comp endianness tempVec (width * sampleCount)
-                                      idx size stride outVec
-
-              stride = V.length $ tiffOffsets nfo
-              idxVector = V.enumFromN 0 stride
-              sizes = V.zip3 idxVector (tiffOffsets nfo) (tiffStripSize nfo)
-
-  unsafeFreezeImage mutableImage
-
-ifdSingleLong :: TiffTag -> Word32 -> Writer [ImageFileDirectory] ()
-ifdSingleLong tag = ifdMultiLong tag . V.singleton
-
-ifdSingleShort :: Endianness -> TiffTag -> Word16
-               -> Writer [ImageFileDirectory] ()
-ifdSingleShort endian tag = ifdMultiShort endian tag . V.singleton . fromIntegral
-
-ifdMultiLong :: TiffTag -> V.Vector Word32 -> Writer [ImageFileDirectory] ()
-ifdMultiLong tag v = tell . pure $ ImageFileDirectory
-        { ifdIdentifier = tag
-        , ifdType       = TypeLong
-        , ifdCount      = fromIntegral $ V.length v
-        , ifdOffset     = offset
-        , ifdExtended   = extended
-        }
-  where (offset, extended)
-                | V.length v > 1 = (0, ExtendedDataLong v)
-                | otherwise = (V.head v, ExtendedDataNone)
-
-ifdMultiShort :: Endianness -> TiffTag -> V.Vector Word32
-              -> Writer [ImageFileDirectory] ()
-ifdMultiShort endian tag v = tell . pure $ ImageFileDirectory
-        { ifdIdentifier = tag
-        , ifdType       = TypeShort
-        , ifdCount      = size
-        , ifdOffset     = offset
-        , ifdExtended   = extended
-        }
-    where size = fromIntegral $ V.length v
-          (offset, extended)
-                | size > 2 = (0, ExtendedDataShort $ V.map fromIntegral v)
-                | size == 2 =
-                    let v1 = fromIntegral $ V.head v
-                        v2 = fromIntegral $ v `V.unsafeIndex` 1
-                    in
-                    case endian of
-                      EndianLittle -> (v2 `unsafeShiftL` 16 .|. v1, ExtendedDataNone)
-                      EndianBig -> (v1 `unsafeShiftL` 16 .|. v2, ExtendedDataNone)
-
-                | otherwise = case endian of
-                    EndianLittle -> (V.head v, ExtendedDataNone)
-                    EndianBig -> (V.head v `unsafeShiftL` 16, ExtendedDataNone)
-
--- | All the IFD must be written in order according to the tag
--- value of the IFD. To avoid getting to much restriction in the
--- serialization code, just sort it.
-orderIfdByTag :: [ImageFileDirectory] -> [ImageFileDirectory]
-orderIfdByTag = sortBy comparer
-  where comparer a b = compare t1 t2
-           where t1 = word16OfTag $ ifdIdentifier a
-                 t2 = word16OfTag $ ifdIdentifier b
-
--- | Given an official offset and a list of IFD, update the offset information
--- of the IFD with extended data.
-setupIfdOffsets :: Word32 -> [ImageFileDirectory] -> [ImageFileDirectory]
-setupIfdOffsets initialOffset lst = snd $ mapAccumL updater startExtended lst
-  where ifdElementCount = fromIntegral $ length lst
-        ifdSize = 12
-        ifdCountSize = 2
-        nextOffsetSize = 4
-        startExtended = initialOffset
-                     + ifdElementCount * ifdSize
-                     + ifdCountSize + nextOffsetSize
-
-        updater ix ifd@(ImageFileDirectory { ifdExtended = ExtendedDataAscii b }) =
-            (ix + fromIntegral (B.length b), ifd { ifdOffset = ix } )
-        updater ix ifd@(ImageFileDirectory { ifdExtended = ExtendedDataLong v })
-            | V.length v > 1 = ( ix + fromIntegral (V.length v * 4)
-                               , ifd { ifdOffset = ix } )
-        updater ix ifd@(ImageFileDirectory { ifdExtended = ExtendedDataShort v })
-            | V.length v > 2 = ( ix + fromIntegral (V.length v * 2)
-                             , ifd { ifdOffset = ix })
-        updater ix ifd = (ix, ifd)
-
-instance BinaryParam B.ByteString TiffInfo where
-  putP rawData nfo = do
-    put $ tiffHeader nfo
-
-    let ifdStartOffset = hdrOffset $ tiffHeader nfo
-        endianness = hdrEndianness $ tiffHeader nfo
-
-        ifdShort = ifdSingleShort endianness
-        ifdShorts = ifdMultiShort endianness
-        list = setupIfdOffsets ifdStartOffset . orderIfdByTag . execWriter $ do
-            ifdSingleLong TagImageWidth $ tiffWidth nfo
-            ifdSingleLong TagImageLength $ tiffHeight nfo
-            ifdShorts TagBitsPerSample $ tiffBitsPerSample nfo
-            ifdSingleLong TagSamplesPerPixel $ tiffSampleCount nfo
-            ifdSingleLong TagRowPerStrip $ tiffRowPerStrip nfo
-            ifdShort TagPhotometricInterpretation
-                                        . packPhotometricInterpretation
-                                        $ tiffColorspace nfo
-            ifdShort TagPlanarConfiguration
-                    . constantToPlaneConfiguration $ tiffPlaneConfiguration nfo
-            ifdShort TagCompression . packCompression
-                                          $ tiffCompression nfo
-            ifdMultiLong TagStripOffsets $ tiffOffsets nfo
-
-            ifdMultiLong TagStripByteCounts $ tiffStripSize nfo
-
-            let subSampling = tiffYCbCrSubsampling nfo
-            when (not $ V.null subSampling) $
-                 ifdShorts TagYCbCrSubsampling subSampling
-
-    putByteString rawData
-    putP endianness list
-    mapM_ (\ifd -> putP (endianness, ifd) $ ifdExtended ifd) list
-
-  getP _ = do
-    hdr <- get
-    readed <- bytesRead
-    skip . fromIntegral $ fromIntegral (hdrOffset hdr) - readed
-    let endian = hdrEndianness hdr
-
-    ifd <- fmap (cleanImageFileDirectory endian) <$> getP endian
-    cleaned <- fetchExtended endian ifd
-
-    let dataFind str tag = findIFDData str tag cleaned
-        dataDefault def tag = findIFDDefaultData def tag cleaned
-        extFind str tag = findIFDExt str tag cleaned
-        extDefault def tag = findIFDExtDefaultData def tag cleaned
-
-    TiffInfo hdr
-        <$> dataFind "Can't find width" TagImageWidth
-        <*> dataFind "Can't find height" TagImageLength
-        <*> (dataFind "Can't find color space" TagPhotometricInterpretation
-                     >>= unpackPhotometricInterpretation)
-        <*> dataFind "Can't find sample per pixel" TagSamplesPerPixel
-        <*> dataFind "Can't find row per strip" TagRowPerStrip
-        <*> (dataDefault 1 TagPlanarConfiguration
-                     >>= planarConfgOfConstant)
-        <*> (extDefault [1] TagSampleFormat
-                     >>= mapM unpackSampleFormat)
-        <*> (extFind "Can't find bit per sample" TagBitsPerSample
-                     >>= unLong "Can't find bit depth")
-        <*> (dataFind "Can't find Compression" TagCompression
-                     >>= unPackCompression)
-        <*> (extFind "Can't find byte counts" TagStripByteCounts
-                     >>= unLong "Can't find bit per sample")
-        <*> (extFind "Strip offsets missing" TagStripOffsets
-                     >>= unLong "Can't find strip offsets")
-        <*> findPalette cleaned
-        <*> (V.fromList <$> extDefault [2, 2] TagYCbCrSubsampling)
-
-unpack :: B.ByteString -> TiffInfo -> Either String DynamicImage
--- | while mandatory some images don't put correct
--- rowperstrip. So replacing 0 with actual image height.
-unpack file nfo@TiffInfo { tiffRowPerStrip = 0 } =
-    unpack file $ nfo { tiffRowPerStrip = tiffHeight nfo }
-unpack file nfo@TiffInfo { tiffColorspace = TiffPaleted
-                         , tiffBitsPerSample = lst
-                         , tiffSampleFormat = format
-                         , tiffPalette = Just p
-                         }
-  | lst == V.singleton 8 && format == [TiffSampleUint] =
-      let applyPalette = pixelMap (\v -> pixelAt p (fromIntegral v) 0)
-          gathered :: Image Pixel8
-          gathered = gatherStrips (0 :: Word8) file nfo
-      in
-      pure . ImageRGB16 $ applyPalette gathered
-
-  | lst == V.singleton 4 && format == [TiffSampleUint] =
-      let applyPalette = pixelMap (\v -> pixelAt p (fromIntegral v) 0)
-          gathered :: Image Pixel8
-          gathered = gatherStrips Pack4 file nfo
-      in
-      pure . ImageRGB16 $ applyPalette gathered
-
-  | lst == V.singleton 2 && format == [TiffSampleUint] =
-      let applyPalette = pixelMap (\v -> pixelAt p (fromIntegral v) 0)
-          gathered :: Image Pixel8
-          gathered = gatherStrips Pack2 file nfo
-      in
-      pure . ImageRGB16 $ applyPalette gathered
-
-unpack file nfo@TiffInfo { tiffColorspace = TiffCMYK
-                         , tiffBitsPerSample = lst
-                         , tiffSampleFormat = format }
-  | lst == V.fromList [8, 8, 8, 8] && all (TiffSampleUint ==) format =
-        pure . ImageCMYK8 $ gatherStrips (0 :: Word8) file nfo
-
-  | lst == V.fromList [16, 16, 16, 16] && all (TiffSampleUint ==) format =
-        pure . ImageCMYK16 $ gatherStrips (0 :: Word16) file nfo
-
-unpack file nfo@TiffInfo { tiffColorspace = TiffMonochromeWhite0 }
-  | otherwise = do
-    img <- unpack file (nfo { tiffColorspace = TiffMonochrome })
-    case img of
-      ImageY8 i -> pure . ImageY8 $ pixelMap (maxBound -) i
-      ImageY16 i -> pure . ImageY16 $ pixelMap (maxBound -) i
-      _ -> pure img
-
-unpack file nfo@TiffInfo { tiffColorspace = TiffMonochrome
-                         , tiffBitsPerSample = lst
-                         , tiffSampleFormat = format }
-  | lst == V.singleton 2 && all (TiffSampleUint ==) format =
-        pure . ImageY8 . pixelMap (colorMap (64 *)) $ gatherStrips Pack2 file nfo
-  | lst == V.singleton 4 && all (TiffSampleUint ==) format =
-        pure . ImageY8 . pixelMap (colorMap (16 *)) $ gatherStrips Pack4 file nfo
-  | lst == V.singleton 8 && all (TiffSampleUint ==) format =
-        pure . ImageY8 $ gatherStrips (0 :: Word8) file nfo
-  | lst == V.singleton 12 && all (TiffSampleUint ==) format =
-        pure . ImageY16 . pixelMap (16 *) $ gatherStrips Pack12 file nfo
-  | lst == V.singleton 16 && all (TiffSampleUint ==) format =
-        pure . ImageY16 $ gatherStrips (0 :: Word16) file nfo
-  | lst == V.singleton 32 && all (TiffSampleUint ==) format =
-        pure . ImageY16 $ pixelMap (toWord16) img
-           where toWord16 v = fromIntegral $ v `unsafeShiftR` 16
-                 img = gatherStrips (0 :: Word32) file nfo :: Image Pixel32
-
-unpack file nfo@TiffInfo { tiffColorspace = TiffYCbCr
-                         , tiffBitsPerSample = lst
-                         , tiffPlaneConfiguration = PlanarConfigContig
-                         , tiffSampleFormat = format }
-  | lst == V.fromList [8, 8, 8] && all (TiffSampleUint ==) format =
-    pure . ImageYCbCr8 $ gatherStrips cbcrConf  file nfo
-      where defaulting 0 = 2
-            defaulting n = n
-
-            w = defaulting $ tiffYCbCrSubsampling nfo V.! 0
-            h = defaulting $ tiffYCbCrSubsampling nfo V.! 1
-            cbcrConf = YCbCrSubsampling
-                { ycbcrWidth        = fromIntegral w
-                , ycbcrHeight       = fromIntegral h
-                , ycbcrImageWidth   = fromIntegral $ tiffWidth nfo
-                , ycbcrStripHeight  = fromIntegral $ tiffRowPerStrip nfo
-                }
-
-unpack file nfo@TiffInfo { tiffColorspace = TiffRGB
-                         , tiffBitsPerSample = lst
-                         , tiffSampleFormat = format }
-  | lst == V.fromList [2, 2, 2] && all (TiffSampleUint ==) format =
-        pure . ImageRGB8 . pixelMap (colorMap (64 *)) $ gatherStrips Pack2 file nfo
-  | lst == V.fromList [4, 4, 4] && all (TiffSampleUint ==) format =
-        pure . ImageRGB8 . pixelMap (colorMap (16 *)) $ gatherStrips Pack4 file nfo
-  | lst == V.fromList [8, 8, 8] && all (TiffSampleUint ==) format =
-        pure . ImageRGB8 $ gatherStrips (0 :: Word8) file nfo
-  | lst == V.fromList [8, 8, 8, 8] && all (TiffSampleUint ==) format =
-        pure . ImageRGBA8 $ gatherStrips (0 :: Word8) file nfo
-  | lst == V.fromList [16, 16, 16] && all (TiffSampleUint ==) format =
-        pure . ImageRGB16 $ gatherStrips (0 :: Word16) file nfo
-  | lst == V.fromList [16, 16, 16, 16] && all (TiffSampleUint ==) format =
-        pure . ImageRGBA16 $ gatherStrips (0 :: Word16) file nfo
-unpack file nfo@TiffInfo { tiffColorspace = TiffMonochrome
-                         , tiffBitsPerSample = lst
-                         , tiffSampleFormat = format }
-  -- some files are a little bit borked...
-  | lst == V.fromList [8, 8, 8] && all (TiffSampleUint ==) format =
-        pure . ImageRGB8 $ gatherStrips (0 :: Word8) file nfo
-
-unpack _ _ = fail "Failure to unpack TIFF file"
-
--- | Transform a raw tiff image to an image, without modifying
--- the underlying pixel type.
---
--- This function can output the following pixel types :
---
--- * PixelY8
---
--- * PixelY16
---
--- * PixelRGB8
---
--- * PixelRGB16
---
--- * PixelCMYK8
---
--- * PixelCMYK16
---
-decodeTiff :: B.ByteString -> Either String DynamicImage
-decodeTiff file = runGetStrict (getP file) file >>= unpack file
-
--- | Class defining which pixel types can be serialized in a
--- Tiff file.
-class (Pixel px) => TiffSaveable px where
-  colorSpaceOfPixel :: px -> TiffColorspace
-
-  subSamplingInfo   :: px -> V.Vector Word32
-  subSamplingInfo _ = V.empty
-
-instance TiffSaveable Pixel8 where
-  colorSpaceOfPixel _ = TiffMonochrome
-
-instance TiffSaveable Pixel16 where
-  colorSpaceOfPixel _ = TiffMonochrome
-
-instance TiffSaveable PixelCMYK8 where
-  colorSpaceOfPixel _ = TiffCMYK
-
-instance TiffSaveable PixelCMYK16 where
-  colorSpaceOfPixel _ = TiffCMYK
-
-instance TiffSaveable PixelRGB8 where
-  colorSpaceOfPixel  _ = TiffRGB
-
-instance TiffSaveable PixelRGB16 where
-  colorSpaceOfPixel  _ = TiffRGB
-
-instance TiffSaveable PixelRGBA8 where
-  colorSpaceOfPixel _ = TiffRGB
-
-instance TiffSaveable PixelRGBA16 where
-  colorSpaceOfPixel _ = TiffRGB
-
-instance TiffSaveable PixelYCbCr8 where
-  colorSpaceOfPixel _ = TiffYCbCr
-  subSamplingInfo _ = V.fromListN 2 [1, 1]
-
--- | Transform an image into a Tiff encoded bytestring, reade to be
--- written as a file.
-encodeTiff :: forall px. (TiffSaveable px) => Image px -> Lb.ByteString
-encodeTiff img = runPut $ putP rawPixelData hdr
-  where intSampleCount = componentCount (undefined :: px)
-        sampleCount = fromIntegral intSampleCount
-
-        sampleType = (undefined :: PixelBaseComponent px)
-        pixelData = imageData img
-
-        rawPixelData = toByteString pixelData
-        width = fromIntegral $ imageWidth img
-        height = fromIntegral $ imageHeight img
-        intSampleSize = sizeOf sampleType
-        sampleSize = fromIntegral intSampleSize
-        bitPerSample = sampleSize * 8
-        imageSize = width * height * sampleCount * sampleSize
-        headerSize = 8
-
-        hdr = TiffInfo
-            { tiffHeader             = TiffHeader
-                                            { hdrEndianness = EndianLittle
-                                            , hdrOffset = headerSize + imageSize
-                                            }
-            , tiffWidth              = width
-            , tiffHeight             = height
-            , tiffColorspace         = colorSpaceOfPixel (undefined :: px)
-            , tiffSampleCount        = fromIntegral $ sampleCount
-            , tiffRowPerStrip        = fromIntegral $ imageHeight img
-            , tiffPlaneConfiguration = PlanarConfigContig
-            , tiffSampleFormat       = [TiffSampleUint]
-            , tiffBitsPerSample      = V.replicate intSampleCount bitPerSample
-            , tiffCompression        = CompressionNone
-            , tiffStripSize          = V.singleton imageSize
-            , tiffOffsets            = V.singleton headerSize
-            , tiffPalette            = Nothing
-            , tiffYCbCrSubsampling   = subSamplingInfo (undefined :: px)
-            }
-
--- | Helper function to directly write an image as a tiff on disk.
-writeTiff :: (TiffSaveable pixel) => FilePath -> Image pixel -> IO ()
-writeTiff path img = Lb.writeFile path $ encodeTiff img
-

@@ -1,1727 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE CPP #-}
--- | Module providing the basic types for image manipulation in the library.
--- Defining the types used to store all those _Juicy Pixels_
-module Codec.Picture.Types( -- * Types
-                            -- ** Image types
-                            Image( .. )
-                          , MutableImage( .. )
-                          , DynamicImage( .. )
-
-                            -- ** Image functions
-                          , freezeImage
-                          , unsafeFreezeImage
-
-                            -- ** Pixel types
-                          , Pixel8
-                          , Pixel16
-                          , Pixel32
-                          , PixelF
-                          , PixelYA8( .. )
-                          , PixelYA16( .. )
-                          , PixelRGB8( .. )
-                          , PixelRGB16( .. )
-                          , PixelRGBF( .. )
-                          , PixelRGBA8( .. )
-                          , PixelRGBA16( .. )
-                          , PixelCMYK8( .. )
-                          , PixelCMYK16( .. )
-                          , PixelYCbCr8( .. )
-
-                          -- * Type classes
-                          , ColorConvertible( .. )
-                          , Pixel(..)
-                          -- $graph
-                          , ColorSpaceConvertible( .. )
-                          , LumaPlaneExtractable( .. )
-                          , TransparentPixel( .. )
-
-                            -- * Helper functions
-                          , pixelMap
-                          , pixelFold
-                          , dynamicMap
-                          , dynamicPixelMap
-                          , dropAlphaLayer
-                          , withImage
-                          , generateImage
-                          , generateFoldImage
-                          , gammaCorrection
-                          , toneMapping
-
-                            -- * Color plane extraction
-                          , ColorPlane ( )
-
-                          , PlaneRed( .. )
-                          , PlaneGreen( .. )
-                          , PlaneBlue( .. )
-                          , PlaneAlpha( .. )
-                          , PlaneLuma( .. )
-                          , PlaneCr( .. )
-                          , PlaneCb( .. )
-                          , PlaneCyan( .. )
-                          , PlaneMagenta( .. )
-                          , PlaneYellow( .. )
-                          , PlaneBlack( .. )
-
-                          , extractComponent
-                          , unsafeExtractComponent
-                          ) where
-
-import Control.Monad( forM_, foldM, liftM, ap )
-import Control.DeepSeq( NFData( .. ) )
-import Control.Monad.ST( runST )
-import Control.Monad.Primitive ( PrimMonad, PrimState )
-import Foreign.Storable ( Storable )
-import Data.Bits( unsafeShiftL, unsafeShiftR )
-import Data.Word( Word8, Word16, Word32 )
-import Data.List( foldl' )
-import Data.Vector.Storable ( (!) )
-import qualified Data.Vector.Storable as V
-import qualified Data.Vector.Storable.Mutable as M
-
-#include "ConvGraph.hs"
-
--- | Image or pixel buffer, the coordinates are assumed to start
--- from the upper-left corner of the image, with the horizontal
--- position first, then the vertical one.
-data Image a = Image
-    { -- | Width of the image in pixels
-      imageWidth  :: {-# UNPACK #-} !Int
-      -- | Height of the image in pixels.
-    , imageHeight :: {-# UNPACK #-} !Int
-
-      -- | The real image, to extract pixels at some position
-      -- you should use the helpers functions.
-    , imageData   :: V.Vector (PixelBaseComponent a)
-    }
-
-{-# INLINE (!!!) #-}
-(!!!) :: (Storable e) => V.Vector e -> Int -> e
-(!!!) = V.unsafeIndex
-
--- | Class used to describle plane present in the pixel
--- type. If a pixel has a plane description associated,
--- you can use the plane name to extract planes independently.
-class ColorPlane pixel planeToken where
-    -- | Retrieve the index of the component in the
-    -- given pixel type.
-    toComponentIndex :: pixel -> planeToken -> Int
-
--- | Define the plane for the red color component
-data PlaneRed = PlaneRed
-
--- | Define the plane for the green color component
-data PlaneGreen = PlaneGreen
-
--- | Define the plane for the blue color component
-data PlaneBlue = PlaneBlue
-
--- | Define the plane for the alpha (transparency) component
-data PlaneAlpha = PlaneAlpha
-
--- | Define the plane for the luma component
-data PlaneLuma = PlaneLuma
-
--- | Define the plane for the Cr component
-data PlaneCr = PlaneCr
-
--- | Define the plane for the Cb component
-data PlaneCb = PlaneCb
-
--- | Define plane for the cyan component of the
--- CMYK color space.
-data PlaneCyan = PlaneCyan
-
--- | Define plane for the magenta component of the
--- CMYK color space.
-data PlaneMagenta = PlaneMagenta
-
--- | Define plane for the yellow component of the
--- CMYK color space.
-data PlaneYellow = PlaneYellow
-
--- | Define plane for the black component of
--- the CMYK color space.
-data PlaneBlack = PlaneBlack
-
--- | Extract a color plane from an image given a present plane in the image
--- examples :
---
--- @
---  extractRedPlane :: Image PixelRGB8-> Image Pixel8
---  extractRedPlane = extractComponent PlaneRed
--- @
---
-extractComponent :: forall px plane. ( Pixel px
-                                     , Pixel (PixelBaseComponent px)
-                                     , PixelBaseComponent (PixelBaseComponent px)
-                                                    ~ PixelBaseComponent px
-                                     , ColorPlane px plane )
-                 => plane -> Image px -> Image (PixelBaseComponent px)
-extractComponent plane = unsafeExtractComponent idx
-    where idx = toComponentIndex (undefined :: px) plane
-
--- | Extract an image plane of an image, returning an image which
--- can be represented by a gray scale image.
--- If you ask a component out of bound, the `error` function will
--- be called
-unsafeExtractComponent :: forall a
-                        . ( Pixel a
-                          , Pixel (PixelBaseComponent a)
-                          , PixelBaseComponent (PixelBaseComponent a)
-                                              ~ PixelBaseComponent a)
-                       => Int     -- ^ The component index, beginning at 0 ending at (componentCount - 1)
-                       -> Image a -- ^ Source image
-                       -> Image (PixelBaseComponent a)
-unsafeExtractComponent comp img@(Image { imageWidth = w, imageHeight = h })
-  | comp >= padd = error $ "extractComponent : invalid component index ("
-                         ++ show comp ++ ", max:" ++ show padd ++ ")"
-  | otherwise = Image { imageWidth = w, imageHeight = h, imageData = plane }
-      where plane = stride img 1 padd comp
-            padd = componentCount (undefined :: a)
-
--- | For any image with an alpha component (transparency),
--- drop it, returning a pure opaque image.
-dropAlphaLayer :: (TransparentPixel a b) => Image a -> Image b
-dropAlphaLayer = pixelMap dropTransparency
-
--- | Class modeling transparent pixel, should provide a method
--- to combine transparent pixels
-class (Pixel a, Pixel b) => TransparentPixel a b | a -> b where
-    -- | Just return the opaque pixel value
-    dropTransparency :: a -> b
-
-instance TransparentPixel PixelRGBA8 PixelRGB8 where
-    {-# INLINE dropTransparency #-}
-    dropTransparency (PixelRGBA8 r g b _) = PixelRGB8 r g b
-
-stride :: (Storable (PixelBaseComponent a))
-       => Image a -> Int -> Int -> Int -> V.Vector (PixelBaseComponent a)
-stride Image { imageWidth = w, imageHeight = h, imageData = array }
-        run padd firstComponent = runST $ do
-    let cell_count = w * h * run
-    outArray <- M.new cell_count
-
-    let strideWrite write_idx _ | write_idx == cell_count = return ()
-        strideWrite write_idx read_idx = do
-            forM_ [0 .. run - 1] $ \i ->
-                (outArray .<-. (write_idx + i)) $ array !!! (read_idx + i)
-            strideWrite (write_idx + run) (read_idx + padd)
-
-    strideWrite 0 firstComponent
-    V.unsafeFreeze outArray
-
-instance NFData (Image a) where
-    rnf (Image width height dat) = width  `seq`
-                                   height `seq`
-                                   dat    `seq`
-                                   ()
-
--- | Image or pixel buffer, the coordinates are assumed to start
--- from the upper-left corner of the image, with the horizontal
--- position first, then the vertical one. The image can be transformed in place.
-data MutableImage s a = MutableImage
-    { -- | Width of the image in pixels
-      mutableImageWidth  :: {-# UNPACK #-} !Int
-
-      -- | Height of the image in pixels.
-    , mutableImageHeight :: {-# UNPACK #-} !Int
-
-      -- | The real image, to extract pixels at some position
-      -- you should use the helpers functions.
-    , mutableImageData   :: M.STVector s (PixelBaseComponent a)
-    }
-
--- | `O(n)` Yield an immutable copy of an image by making a copy of it
-freezeImage :: (Storable (PixelBaseComponent a), PrimMonad m)
-            => MutableImage (PrimState m) a -> m (Image a)
-freezeImage (MutableImage w h d) = Image w h `liftM` V.freeze d
-
--- | `O(1)` Unsafe convert a mutable image to an immutable one without copying.
--- The mutable image may not be used after this operation.
-unsafeFreezeImage ::  (Storable (PixelBaseComponent a), PrimMonad m)
-                  => MutableImage (PrimState m) a -> m (Image a)
-unsafeFreezeImage (MutableImage w h d) = Image w h `liftM` V.unsafeFreeze d
-
-instance NFData (MutableImage s a) where
-    rnf (MutableImage width height dat) = width  `seq`
-                                          height `seq`
-                                          dat    `seq`
-                                          ()
-
--- | Type allowing the loading of an image with different pixel
--- structures
-data DynamicImage =
-       -- | A greyscale image.
-       ImageY8    (Image Pixel8)
-       -- | A greyscale image with 16bit components
-     | ImageY16   (Image Pixel16)
-       -- | A greyscale HDR image
-     | ImageYF    (Image PixelF)
-       -- | An image in greyscale with an alpha channel.
-     | ImageYA8   (Image PixelYA8)
-      -- | An image in greyscale with alpha channel on 16 bits.
-     | ImageYA16  (Image PixelYA16)
-       -- | An image in true color.
-     | ImageRGB8  (Image PixelRGB8)
-       -- | An image in true color with 16bit depth.
-     | ImageRGB16 (Image PixelRGB16)
-       -- | An image with HDR pixels
-     | ImageRGBF  (Image PixelRGBF)
-       -- | An image in true color and an alpha channel.
-     | ImageRGBA8 (Image PixelRGBA8)
-       -- | A true color image with alpha on 16 bits.
-     | ImageRGBA16 (Image PixelRGBA16)
-       -- | An image in the colorspace used by Jpeg images.
-     | ImageYCbCr8 (Image PixelYCbCr8)
-       -- | An image in the colorspace CMYK
-     | ImageCMYK8  (Image PixelCMYK8)
-       -- | An image in the colorspace CMYK and 16 bots precision
-     | ImageCMYK16 (Image PixelCMYK16)
-
--- | Helper function to help extract information from dynamic
--- image. To get the width of an dynamic image, you can use
--- the following snippet :
---
--- > dynWidth :: DynamicImage -> Int
--- > dynWidth img = dynamicMap imageWidth img
---
-dynamicMap :: (forall pixel . (Pixel pixel) => Image pixel -> a)
-           -> DynamicImage -> a
-dynamicMap f (ImageY8    i) = f i
-dynamicMap f (ImageY16   i) = f i
-dynamicMap f (ImageYF    i) = f i
-dynamicMap f (ImageYA8   i) = f i
-dynamicMap f (ImageYA16  i) = f i
-dynamicMap f (ImageRGB8  i) = f i
-dynamicMap f (ImageRGB16 i) = f i
-dynamicMap f (ImageRGBF  i) = f i
-dynamicMap f (ImageRGBA8 i) = f i
-dynamicMap f (ImageRGBA16 i) = f i
-dynamicMap f (ImageYCbCr8 i) = f i
-dynamicMap f (ImageCMYK8 i) = f i
-dynamicMap f (ImageCMYK16 i) = f i
-
--- | Equivalent of the `pixelMap` function for the dynamic images.
--- You can perform pixel colorspace independant operations with this
--- function.
---
--- For instance, if you wan't to extract a square crop of any image,
--- without caring about colorspace, you can use the following snippet.
---
--- > dynSquare :: DynamicImage -> DynamicImage
--- > dynSquare = dynMap squareImage
--- >
--- > squareImage :: Pixel a => Image a -> Image a
--- > squareImage img = generateImage (\x y -> pixelAt img x y) edge edge
--- >    where edge = min (imageWidth img) (imageHeight img)
---
-dynamicPixelMap :: (forall pixel . (Pixel pixel) => Image pixel -> Image pixel)
-                -> DynamicImage -> DynamicImage
-dynamicPixelMap f = aux
-  where
-    aux (ImageY8    i) = ImageY8 (f i)
-    aux (ImageY16   i) = ImageY16 (f i)
-    aux (ImageYF    i) = ImageYF (f i)
-    aux (ImageYA8   i) = ImageYA8 (f i)
-    aux (ImageYA16  i) = ImageYA16 (f i)
-    aux (ImageRGB8  i) = ImageRGB8 (f i)
-    aux (ImageRGB16 i) = ImageRGB16 (f i)
-    aux (ImageRGBF  i) = ImageRGBF (f i)
-    aux (ImageRGBA8 i) = ImageRGBA8 (f i)
-    aux (ImageRGBA16 i) = ImageRGBA16 (f i)
-    aux (ImageYCbCr8 i) = ImageYCbCr8 (f i)
-    aux (ImageCMYK8 i) = ImageCMYK8 (f i)
-    aux (ImageCMYK16 i) = ImageCMYK16 (f i)
-
-instance NFData DynamicImage where
-    rnf (ImageY8 img)     = rnf img
-    rnf (ImageY16 img)    = rnf img
-    rnf (ImageYF img)     = rnf img
-    rnf (ImageYA8 img)    = rnf img
-    rnf (ImageYA16 img)   = rnf img
-    rnf (ImageRGB8 img)   = rnf img
-    rnf (ImageRGB16 img)  = rnf img
-    rnf (ImageRGBF img)   = rnf img
-    rnf (ImageRGBA8 img)  = rnf img
-    rnf (ImageRGBA16 img) = rnf img
-    rnf (ImageYCbCr8 img) = rnf img
-    rnf (ImageCMYK8 img)  = rnf img
-    rnf (ImageCMYK16 img)  = rnf img
-
--- | Simple alias for greyscale value in 8 bits.
-type Pixel8 = Word8
-
--- | Simple alias for greyscale value in 16 bits.
-type Pixel16 = Word16
-
--- | Simple alias for greyscale value in 16 bits.
-type Pixel32 = Word32
-
--- | Floating greyscale value, the 0 to 255 8 bit range maps
--- to 0 to 1 in this floating version
-type PixelF = Float
-
--- | Pixel type storing Luminance (Y) and alpha information
--- on 8 bits.
--- Value are stored in the following order :
---
---  * Luminance
---
---  * Alpha
---
-data PixelYA8 = PixelYA8 {-# UNPACK #-} !Pixel8  -- Luminance
-                         {-# UNPACK #-} !Pixel8  -- Alpha value
-              deriving (Eq, Show)
-
--- | Pixel type storing Luminance (Y) and alpha information
--- on 16 bits.
--- Value are stored in the following order :
---
---  * Luminance
---
---  * Alpha
---
-data PixelYA16 = PixelYA16 {-# UNPACK #-} !Pixel16  -- Luminance
-                           {-# UNPACK #-} !Pixel16  -- Alpha value
-              deriving (Eq, Show)
-
--- | Pixel type storing classic pixel on 8 bits
--- Value are stored in the following order :
---
---  * Red
---
---  * Green
---
---  * Blue
---
-data PixelRGB8 = PixelRGB8 {-# UNPACK #-} !Pixel8 -- Red
-                           {-# UNPACK #-} !Pixel8 -- Green
-                           {-# UNPACK #-} !Pixel8 -- Blue
-               deriving (Eq, Show)
-
--- | Pixel type storing pixels on 16 bits
--- Value are stored in the following order :
---
---  * Red
---
---  * Green
---
---  * Blue
---
-data PixelRGB16 = PixelRGB16 {-# UNPACK #-} !Pixel16 -- Red
-                             {-# UNPACK #-} !Pixel16 -- Green
-                             {-# UNPACK #-} !Pixel16 -- Blue
-               deriving (Eq, Show)
-
--- | Pixel type storing HDR pixel on 32 bits float
--- Value are stored in the following order :
---
---  * Red
---
---  * Green
---
---  * Blue
---
-data PixelRGBF = PixelRGBF {-# UNPACK #-} !PixelF -- Red
-                           {-# UNPACK #-} !PixelF -- Green
-                           {-# UNPACK #-} !PixelF -- Blue
-               deriving (Eq, Show)
-
--- | Pixel storing data in the YCbCr colorspace,
--- value are stored in the following order :
---
---  * Y (luminance)
---
---  * Cr
---
---  * Cb
---
-data PixelYCbCr8 = PixelYCbCr8 {-# UNPACK #-} !Pixel8 -- Y luminance
-                               {-# UNPACK #-} !Pixel8 -- Cr red difference
-                               {-# UNPACK #-} !Pixel8 -- Cb blue difference
-                 deriving (Eq, Show)
-
--- | Pixel storing data in the CMYK colorspace. value
--- are stored in the following order :
---
---   * Cyan
---
---   * Magenta
---
---   * Yellow
---
---   * Black
---
-data PixelCMYK8 = PixelCMYK8 {-# UNPACK #-} !Pixel8 -- Cyan
-                             {-# UNPACK #-} !Pixel8 -- Magenta
-                             {-# UNPACK #-} !Pixel8 -- Yellow
-                             {-# UNPACK #-} !Pixel8 -- Black
-                 deriving (Eq, Show)
-
--- | Pixel storing data in the CMYK colorspace. value
--- are stored in the following order :
---
---   * Cyan
---
---   * Magenta
---
---   * Yellow
---
---   * Black
---
-data PixelCMYK16 = PixelCMYK16 {-# UNPACK #-} !Pixel16 -- Cyan
-                               {-# UNPACK #-} !Pixel16 -- Magenta
-                               {-# UNPACK #-} !Pixel16 -- Yellow
-                               {-# UNPACK #-} !Pixel16 -- Black
-                 deriving (Eq, Show)
-
-
--- | Pixel type storing a classic pixel, with an alpha component.
--- Values are stored in the following order
---
---  * Red
---
---  * Green
---
---  * Blue
---
---  * Alpha
---
-data PixelRGBA8 = PixelRGBA8 {-# UNPACK #-} !Pixel8 -- Red
-                             {-# UNPACK #-} !Pixel8 -- Green
-                             {-# UNPACK #-} !Pixel8 -- Blue
-                             {-# UNPACK #-} !Pixel8 -- Alpha
-                deriving (Eq, Show)
-
--- | Pixel type storing a RGB information with an alpha
--- channel on 16 bits.
--- Values are stored in the following order
---
---  * Red
---
---  * Green
---
---  * Blue
---
---  * Alpha
---
-data PixelRGBA16 = PixelRGBA16 {-# UNPACK #-} !Pixel16 -- Red
-                               {-# UNPACK #-} !Pixel16 -- Green
-                               {-# UNPACK #-} !Pixel16 -- Blue
-                               {-# UNPACK #-} !Pixel16 -- Alpha
-                deriving (Eq, Show)
-
--- | Definition of pixels used in images. Each pixel has a color space, and a representative
--- component (Word8 or Float).
-class ( Storable (PixelBaseComponent a)
-      , Num (PixelBaseComponent a), Eq a ) => Pixel a where
-    -- | Type of the pixel component, "classical" images
-    -- would have Word8 type as their PixelBaseComponent,
-    -- HDR image would have Float for instance
-    type PixelBaseComponent a :: *
-
-    -- | Call the function for every component of the pixels.
-    -- For example for RGB pixels mixWith is declared like this :
-    --
-    -- > mixWith f (PixelRGB8 ra ga ba) (PixelRGB8 rb gb bb) =
-    -- >    PixelRGB8 (f 0 ra rb) (f 1 ga gb) (f 2 ba bb)
-    --
-    mixWith :: (Int -> PixelBaseComponent a -> PixelBaseComponent a -> PixelBaseComponent a)
-            -> a -> a -> a
-
-    -- | Return the number of component of the pixel
-    componentCount :: a -> Int
-
-    -- | Apply a function to all color component of a pixel.
-    colorMap :: (PixelBaseComponent a -> PixelBaseComponent a) -> a -> a
-
-    -- | Calculate the index for the begining of the pixel
-    pixelBaseIndex :: Image a -> Int -> Int -> Int
-    pixelBaseIndex (Image { imageWidth = w }) x y =
-            (x + y * w) * componentCount (undefined :: a)
-
-    -- | Calculate theindex for the begining of the pixel at position x y
-    mutablePixelBaseIndex :: MutableImage s a -> Int -> Int -> Int
-    mutablePixelBaseIndex (MutableImage { mutableImageWidth = w }) x y =
-            (x + y * w) * componentCount (undefined :: a)
-
-    -- | Extract a pixel at a given position, (x, y), the origin
-    -- is assumed to be at the corner top left, positive y to the
-    -- bottom of the image
-    pixelAt :: Image a -> Int -> Int -> a
-
-    -- | Same as pixelAt but for mutable images.
-    readPixel :: PrimMonad m => MutableImage (PrimState m) a -> Int -> Int -> m a
-
-    -- | Write a pixel in a mutable image at position x y
-    writePixel :: PrimMonad m => MutableImage (PrimState m) a -> Int -> Int -> a -> m ()
-
-    -- | Unsafe version of pixelAt, read a pixel at the given
-    -- index without bound checking (if possible).
-    -- The index is expressed in number (PixelBaseComponent a)
-    unsafePixelAt :: V.Vector (PixelBaseComponent a) -> Int -> a
-
-    -- | Unsafe version of readPixel,  read a pixel at the given
-    -- position without bound checking (if possible). The index
-    -- is expressed in number (PixelBaseComponent a)
-    unsafeReadPixel :: PrimMonad m => M.STVector (PrimState m) (PixelBaseComponent a) -> Int -> m a
-
-    -- | Unsafe version of writePixel, write a pixel at the
-    -- given position without bound checking. This can be _really_ unsafe.
-    -- The index is expressed in number (PixelBaseComponent a)
-    unsafeWritePixel :: PrimMonad m => M.STVector (PrimState m) (PixelBaseComponent a) -> Int -> a -> m ()
-
-
--- | Implement upcasting for pixel types
--- Minimal declaration declaration `promotePixel`
--- It is strongly recommanded to overload promoteImage to keep
--- performance acceptable
-class (Pixel a, Pixel b) => ColorConvertible a b where
-    -- | Convert a pixel type to another pixel type. This
-    -- operation should never loss any data.
-    promotePixel :: a -> b
-
-    -- | Change the underlying pixel type of an image by performing a full copy
-    -- of it.
-    promoteImage :: Image a -> Image b
-    promoteImage = pixelMap promotePixel
-
--- | This class abstract colorspace conversion. This
--- conversion can be lossy, which ColorConvertible cannot
-class (Pixel a, Pixel b) => ColorSpaceConvertible a b where
-    -- | Pass a pixel from a colorspace (say RGB) to the second one
-    -- (say YCbCr)
-    convertPixel :: a -> b
-
-    -- | Helper function to convert a whole image by taking a
-    -- copy it.
-    convertImage :: Image a -> Image b
-    convertImage = pixelMap convertPixel
-
--- | Create an image given a function to generate pixels.
--- The function will receive value from 0 to width-1 for the x parameter
--- and 0 to height-1 for the y parameter. The coordinate 0,0 is the upper
--- left corner of the image, and (width-1, height-1) the lower right corner.
---
--- for example, to create a small gradient image :
---
--- > imageCreator :: String -> Image PixelRGB8
--- > imageCreator path = writePng path $ generateImage pixelRenderer 250 300
--- >    where pixelRenderer x y = PixelRGB8 x y 128
---
-generateImage :: forall a. (Pixel a)
-              => (Int -> Int -> a)  -- ^ Generating function, with `x` and `y` params.
-              -> Int        -- ^ Width in pixels
-              -> Int        -- ^ Height in pixels
-              -> Image a
-generateImage f w h = Image { imageWidth = w, imageHeight = h, imageData = generated }
-  where compCount = componentCount (undefined :: a)
-        generated = runST $ do
-            arr <- M.new (w * h * compCount)
-            let lineGenerator _ y | y >= h = return ()
-                lineGenerator lineIdx y = column lineIdx 0
-                  where column idx x | x >= w = lineGenerator idx $ y + 1
-                        column idx x = do
-                            unsafeWritePixel arr idx $ f x y
-                            column (idx + compCount) $ x + 1
-
-            lineGenerator 0 0
-            V.unsafeFreeze arr
-
--- | Create an image using a monadic initializer function.
--- The function will receive value from 0 to width-1 for the x parameter
--- and 0 to height-1 for the y parameter. The coordinate 0,0 is the upper
--- left corner of the image, and (width-1, height-1) the lower right corner.
---
--- The function is called for each pixel in the line from left to right (0 to width - 1)
--- and for each line (0 to height - 1).
-withImage :: forall m pixel. (Pixel pixel, PrimMonad m)
-          => Int                     -- ^ Image width
-          -> Int                     -- ^ Image height
-          -> (Int -> Int -> m pixel) -- ^ Generating functions
-          -> m (Image pixel)
-withImage width height pixelGenerator = do
-  let pixelComponentCount = componentCount (undefined :: pixel)
-  arr <- M.new (width * height * pixelComponentCount)
-  let mutImage = MutableImage
-        { mutableImageWidth = width
-        , mutableImageHeight = height
-        , mutableImageData = arr
-        }
-
-  let pixelPositions = [(x, y) | y <- [0 .. height-1], x <- [0..width-1]]
-  sequence_ [pixelGenerator x y >>= unsafeWritePixel arr idx
-                        | ((x,y), idx) <- zip pixelPositions [0, pixelComponentCount ..]]
-  unsafeFreezeImage mutImage
-
--- | Create an image given a function to generate pixels.
--- The function will receive value from 0 to width-1 for the x parameter
--- and 0 to height-1 for the y parameter. The coordinate 0,0 is the upper
--- left corner of the image, and (width-1, height-1) the lower right corner.
---
--- the acc parameter is a user defined one.
---
--- The function is called for each pixel in the line from left to right (0 to width - 1)
--- and for each line (0 to height - 1).
-generateFoldImage :: forall a acc. (Pixel a)
-                  => (acc -> Int -> Int -> (acc, a)) -- ^ Function taking the state, x and y
-                  -> acc        -- ^ Initial state
-                  -> Int        -- ^ Width in pixels
-                  -> Int        -- ^ Height in pixels
-                  -> (acc, Image a)
-generateFoldImage f intialAcc w h =
- (finalState, Image { imageWidth = w, imageHeight = h, imageData = generated })
-  where compCount = componentCount (undefined :: a)
-        (finalState, generated) = runST $ do
-            arr <- M.new (w * h * compCount)
-            let mutImage = MutableImage {
-                                mutableImageWidth = w,
-                                mutableImageHeight = h,
-                                mutableImageData = arr }
-            foldResult <- foldM (\acc (x,y) -> do
-                    let (acc', px) = f acc x y
-                    writePixel mutImage x y px
-                    return acc') intialAcc [(x,y) | y <- [0 .. h-1], x <- [0 .. w-1]]
-
-            frozen <- V.unsafeFreeze arr
-            return (foldResult, frozen)
-
--- | Fold over the pixel of an image with a raster scan order :
--- from top to bottom, left to right
-{-# INLINE pixelFold #-}
-pixelFold :: (Pixel pixel)
-          => (acc -> Int -> Int -> pixel -> acc) -> acc -> Image pixel -> acc
-pixelFold f initialAccumulator img@(Image { imageWidth = w, imageHeight = h }) =
-  lineFold
-    where pixelFolder y acc x = f acc x y $ pixelAt img x y
-          columnFold lineAcc y = foldl' (pixelFolder y) lineAcc [0 .. w - 1]
-          lineFold = foldl' columnFold initialAccumulator [0 .. h - 1]
-
--- | `map` equivalent for an image, working at the pixel level.
--- Little example : a brightness function for an rgb image
---
--- > brightnessRGB8 :: Int -> Image PixelRGB8 -> Image PixelRGB8
--- > brightnessRGB8 add = pixelMap brightFunction
--- >      where up v = fromIntegral (fromIntegral v + add)
--- >            brightFunction (PixelRGB8 r g b) =
--- >                    PixelRGB8 (up r) (up g) (up b)
---
-pixelMap :: forall a b. (Pixel a, Pixel b)
-         => (a -> b) -> Image a -> Image b
-{-# RULES "pixelMap fusion" forall g f. pixelMap g . pixelMap f = pixelMap (g . f) #-}
-{-# SPECIALIZE INLINE pixelMap :: (PixelYCbCr8 -> PixelRGB8) -> Image PixelYCbCr8 -> Image PixelRGB8 #-}
-{-# SPECIALIZE INLINE pixelMap :: (PixelRGB8 -> PixelYCbCr8) -> Image PixelRGB8 -> Image PixelYCbCr8 #-}
-{-# SPECIALIZE INLINE pixelMap :: (PixelRGB8 -> PixelRGB8) -> Image PixelRGB8 -> Image PixelRGB8 #-}
-{-# SPECIALIZE INLINE pixelMap :: (PixelRGB8 -> PixelRGBA8) -> Image PixelRGB8 -> Image PixelRGBA8 #-}
-{-# SPECIALIZE INLINE pixelMap :: (PixelRGBA8 -> PixelRGBA8) -> Image PixelRGBA8 -> Image PixelRGBA8 #-}
-{-# SPECIALIZE INLINE pixelMap :: (Pixel8 -> PixelRGB8) -> Image Pixel8 -> Image PixelRGB8 #-}
-pixelMap f Image { imageWidth = w, imageHeight = h, imageData = vec } =
-  Image w h pixels
-    where sourceComponentCount = componentCount (undefined :: a)
-          destComponentCount = componentCount (undefined :: b)
-
-          pixels = runST $ do
-            newArr <- M.new (w * h * destComponentCount)
-            let lineMapper _ _ y | y >= h = return ()
-                lineMapper readIdxLine writeIdxLine y = colMapper readIdxLine writeIdxLine 0
-                  where colMapper readIdx writeIdx x
-                            | x >= w = lineMapper readIdx writeIdx $ y + 1
-                            | otherwise = do
-                                unsafeWritePixel newArr writeIdx . f $ unsafePixelAt vec readIdx
-                                colMapper (readIdx + sourceComponentCount)
-                                          (writeIdx + destComponentCount)
-                                          (x + 1)
-            lineMapper 0 0 0
-
-            -- unsafeFreeze avoids making a second copy and it will be
-            -- safe because newArray can't be referenced as a mutable array
-            -- outside of this where block
-            V.unsafeFreeze newArr
-
--- | Helper class to help extract a luma plane out
--- of an image or a pixel
-class (Pixel a, Pixel (PixelBaseComponent a)) => LumaPlaneExtractable a where
-    -- | Compute the luminance part of a pixel
-    computeLuma      :: a -> (PixelBaseComponent a)
-
-    -- | Extract a luma plane out of an image. This
-    -- method is in the typeclass to help performant
-    -- implementation.
-    --
-    -- > jpegToGrayScale :: FilePath -> FilePath -> IO ()
-    -- > jpegToGrayScale source dest
-    extractLumaPlane :: Image a -> Image (PixelBaseComponent a)
-    extractLumaPlane = pixelMap computeLuma
-
-instance LumaPlaneExtractable Pixel8 where
-    {-# INLINE computeLuma #-}
-    computeLuma = id
-    extractLumaPlane = id
-
-instance LumaPlaneExtractable Pixel16 where
-    {-# INLINE computeLuma #-}
-    computeLuma = id
-    extractLumaPlane = id
-
-instance LumaPlaneExtractable Pixel32 where
-    {-# INLINE computeLuma #-}
-    computeLuma = id
-    extractLumaPlane = id
-
-instance LumaPlaneExtractable PixelF where
-    {-# INLINE computeLuma #-}
-    computeLuma = id
-    extractLumaPlane = id
-
-instance LumaPlaneExtractable PixelRGBF where
-    {-# INLINE computeLuma #-}
-    computeLuma (PixelRGBF r g b) =
-        0.3 * r + 0.59 * g + 0.11 * b
-
-instance LumaPlaneExtractable PixelRGBA8 where
-    {-# INLINE computeLuma #-}
-    computeLuma (PixelRGBA8 r g b _) = floor $ 0.3 * toRational r +
-                                             0.59 * toRational g +
-                                             0.11 * toRational b
-
-instance LumaPlaneExtractable PixelYCbCr8 where
-    {-# INLINE computeLuma #-}
-    computeLuma (PixelYCbCr8 y _ _) = y
-    extractLumaPlane = extractComponent PlaneLuma
-
--- | Free promotion for identic pixel types
-instance (Pixel a) => ColorConvertible a a where
-    {-# INLINE promotePixel #-}
-    promotePixel = id
-
-    {-# INLINE promoteImage #-}
-    promoteImage = id
-
-{-# INLINE (.!!!.) #-}
-(.!!!.) :: (PrimMonad m, Storable a) => M.STVector (PrimState m) a -> Int -> m a
-(.!!!.) = M.read -- unsafeRead
-
-{-# INLINE (.<-.) #-}
-(.<-.) :: (PrimMonad m, Storable a) => M.STVector (PrimState m) a -> Int -> a -> m ()
-(.<-.)  = M.write -- unsafeWrite
-
---------------------------------------------------
-----            Pixel8 instances
---------------------------------------------------
-instance Pixel Pixel8 where
-    type PixelBaseComponent Pixel8 = Word8
-
-    {-# INLINE mixWith #-}
-    mixWith f = f 0
-
-    {-# INLINE colorMap #-}
-    colorMap f = f
-
-    componentCount _ = 1
-    pixelAt (Image { imageWidth = w, imageData = arr }) x y = arr ! (x + y * w)
-
-    readPixel image@(MutableImage { mutableImageData = arr }) x y =
-        arr `M.read` mutablePixelBaseIndex image x y
-
-    writePixel image@(MutableImage { mutableImageData = arr }) x y =
-        arr `M.write` mutablePixelBaseIndex image x y
-
-    unsafePixelAt = V.unsafeIndex
-    unsafeReadPixel = M.unsafeRead
-    unsafeWritePixel = M.unsafeWrite
-
-instance ColorConvertible Pixel8 PixelYA8 where
-    {-# INLINE promotePixel #-}
-    promotePixel c = PixelYA8 c 255
-
-instance ColorConvertible Pixel8 PixelF where
-    {-# INLINE promotePixel #-}
-    promotePixel c = fromIntegral c / 255.0
-
-instance ColorConvertible Pixel8 Pixel16 where
-    {-# INLINE promotePixel #-}
-    promotePixel c = fromIntegral c `unsafeShiftL` 8
-
-instance ColorConvertible Pixel8 PixelRGB8 where
-    {-# INLINE promotePixel #-}
-    promotePixel c = PixelRGB8 c c c
-
-instance ColorConvertible Pixel8 PixelRGBA8 where
-    {-# INLINE promotePixel #-}
-    promotePixel c = PixelRGBA8 c c c 255
-
---------------------------------------------------
-----            Pixel16 instances
---------------------------------------------------
-instance Pixel Pixel16 where
-    type PixelBaseComponent Pixel16 = Word16
-
-    {-# INLINE mixWith #-}
-    mixWith f = f 0
-
-    {-# INLINE colorMap #-}
-    colorMap f = f
-
-    componentCount _ = 1
-    pixelAt (Image { imageWidth = w, imageData = arr }) x y = arr ! (x + y * w)
-
-    readPixel image@(MutableImage { mutableImageData = arr }) x y =
-        arr `M.read` mutablePixelBaseIndex image x y
-
-    writePixel image@(MutableImage { mutableImageData = arr }) x y =
-        arr `M.write` mutablePixelBaseIndex image x y
-
-    unsafePixelAt = V.unsafeIndex
-    unsafeReadPixel = M.unsafeRead
-    unsafeWritePixel = M.unsafeWrite
-
-instance ColorConvertible Pixel16 PixelYA16 where
-    {-# INLINE promotePixel #-}
-    promotePixel c = PixelYA16 c maxBound
-
-instance ColorConvertible Pixel16 PixelRGB16 where
-    {-# INLINE promotePixel #-}
-    promotePixel c = PixelRGB16 c c c
-
-instance ColorConvertible Pixel16 PixelRGBA16 where
-    {-# INLINE promotePixel #-}
-    promotePixel c = PixelRGBA16 c c c maxBound
-
---------------------------------------------------
-----            Pixel32 instances
---------------------------------------------------
-instance Pixel Pixel32 where
-    type PixelBaseComponent Pixel32 = Word32
-
-    {-# INLINE mixWith #-}
-    mixWith f = f 0
-
-    {-# INLINE colorMap #-}
-    colorMap f = f
-
-    componentCount _ = 1
-    pixelAt (Image { imageWidth = w, imageData = arr }) x y = arr ! (x + y * w)
-
-    readPixel image@(MutableImage { mutableImageData = arr }) x y =
-        arr `M.read` mutablePixelBaseIndex image x y
-
-    writePixel image@(MutableImage { mutableImageData = arr }) x y =
-        arr `M.write` mutablePixelBaseIndex image x y
-
-    unsafePixelAt = V.unsafeIndex
-    unsafeReadPixel = M.unsafeRead
-    unsafeWritePixel = M.unsafeWrite
-
---------------------------------------------------
-----            PixelF instances
---------------------------------------------------
-instance Pixel PixelF where
-    type PixelBaseComponent PixelF = Float
-
-    {-# INLINE mixWith #-}
-    mixWith f = f 0
-
-    {-# INLINE colorMap #-}
-    colorMap f = f
-    componentCount _ = 1
-    pixelAt (Image { imageWidth = w, imageData = arr }) x y = arr ! (x + y * w)
-
-    readPixel image@(MutableImage { mutableImageData = arr }) x y =
-        arr `M.read` mutablePixelBaseIndex image x y
-
-    writePixel image@(MutableImage { mutableImageData = arr }) x y =
-        arr `M.write` mutablePixelBaseIndex image x y
-
-    unsafePixelAt = V.unsafeIndex
-    unsafeReadPixel = M.unsafeRead
-    unsafeWritePixel = M.unsafeWrite
-
-instance ColorConvertible PixelF PixelRGBF where
-    {-# INLINE promotePixel #-}
-    promotePixel c = PixelRGBF c c c-- (c / 0.3) (c / 0.59)  (c / 0.11)
-
---------------------------------------------------
-----            PixelYA8 instances
---------------------------------------------------
-instance Pixel PixelYA8 where
-    type PixelBaseComponent PixelYA8 = Word8
-
-    {-# INLINE mixWith #-}
-    mixWith f (PixelYA8 ya aa) (PixelYA8 yb ab) =
-        PixelYA8 (f 0 ya yb) (f 1 aa ab)
-
-
-    {-# INLINE colorMap #-}
-    colorMap f (PixelYA8 y a) = PixelYA8 (f y) (f a)
-    componentCount _ = 2
-    pixelAt image@(Image { imageData = arr }) x y = PixelYA8 (arr ! (baseIdx + 0))
-                                                             (arr ! (baseIdx + 1))
-        where baseIdx = pixelBaseIndex image x y
-
-    readPixel image@(MutableImage { mutableImageData = arr }) x y = do
-        yv <- arr .!!!. baseIdx
-        av <- arr .!!!. (baseIdx + 1)
-        return $ PixelYA8 yv av
-        where baseIdx = mutablePixelBaseIndex image x y
-
-    writePixel image@(MutableImage { mutableImageData = arr }) x y (PixelYA8 yv av) = do
-        let baseIdx = mutablePixelBaseIndex image x y
-        (arr .<-. (baseIdx + 0)) yv
-        (arr .<-. (baseIdx + 1)) av
-
-    unsafePixelAt v idx =
-        PixelYA8 (V.unsafeIndex v idx) (V.unsafeIndex v $ idx + 1)
-    unsafeReadPixel vec idx =
-        PixelYA8 `liftM` M.unsafeRead vec idx `ap` M.unsafeRead vec (idx + 1)
-    unsafeWritePixel v idx (PixelYA8 y a) =
-        M.unsafeWrite v idx y >> M.unsafeWrite v (idx + 1) a
-
-instance ColorConvertible PixelYA8 PixelRGB8 where
-    {-# INLINE promotePixel #-}
-    promotePixel (PixelYA8 y _) = PixelRGB8 y y y
-
-instance ColorConvertible PixelYA8 PixelRGBA8 where
-    {-# INLINE promotePixel #-}
-    promotePixel (PixelYA8 y a) = PixelRGBA8 y y y a
-
-instance ColorPlane PixelYA8 PlaneLuma where
-    toComponentIndex _ _ = 0
-
-instance ColorPlane PixelYA8 PlaneAlpha where
-    toComponentIndex _ _ = 1
-
-instance TransparentPixel PixelYA8 Pixel8 where
-    {-# INLINE dropTransparency #-}
-    dropTransparency (PixelYA8 y _) = y
-
-instance LumaPlaneExtractable PixelYA8 where
-    {-# INLINE computeLuma #-}
-    computeLuma (PixelYA8 y _) = y
-    extractLumaPlane = extractComponent PlaneLuma
-
---------------------------------------------------
-----            PixelYA16 instances
---------------------------------------------------
-instance Pixel PixelYA16 where
-    type PixelBaseComponent PixelYA16 = Word16
-
-    {-# INLINE mixWith #-}
-    mixWith f (PixelYA16 ya aa) (PixelYA16 yb ab) =
-        PixelYA16 (f 0 ya yb) (f 1 aa ab)
-
-    {-# INLINE colorMap #-}
-    colorMap f (PixelYA16 y a) = PixelYA16 (f y) (f a)
-    componentCount _ = 2
-    pixelAt image@(Image { imageData = arr }) x y = PixelYA16 (arr ! (baseIdx + 0))
-                                                              (arr ! (baseIdx + 1))
-        where baseIdx = pixelBaseIndex image x y
-
-    readPixel image@(MutableImage { mutableImageData = arr }) x y = do
-        yv <- arr .!!!. baseIdx
-        av <- arr .!!!. (baseIdx + 1)
-        return $ PixelYA16 yv av
-        where baseIdx = mutablePixelBaseIndex image x y
-
-    writePixel image@(MutableImage { mutableImageData = arr }) x y (PixelYA16 yv av) = do
-        let baseIdx = mutablePixelBaseIndex image x y
-        (arr .<-. (baseIdx + 0)) yv
-        (arr .<-. (baseIdx + 1)) av
-
-    unsafePixelAt v idx =
-        PixelYA16 (V.unsafeIndex v idx) (V.unsafeIndex v $ idx + 1)
-    unsafeReadPixel vec idx =
-        PixelYA16 `liftM` M.unsafeRead vec idx `ap` M.unsafeRead vec (idx + 1)
-    unsafeWritePixel v idx (PixelYA16 y a) =
-        M.unsafeWrite v idx y >> M.unsafeWrite v (idx + 1) a
-
-instance ColorConvertible PixelYA16 PixelRGBA16 where
-    {-# INLINE promotePixel #-}
-    promotePixel (PixelYA16 y a) = PixelRGBA16 y y y a
-
-instance ColorPlane PixelYA16 PlaneLuma where
-    toComponentIndex _ _ = 0
-
-instance ColorPlane PixelYA16 PlaneAlpha where
-    toComponentIndex _ _ = 1
-
-instance TransparentPixel PixelYA16 Pixel16 where
-    {-# INLINE dropTransparency #-}
-    dropTransparency (PixelYA16 y _) = y
---------------------------------------------------
-----            PixelRGBF instances
---------------------------------------------------
-instance Pixel PixelRGBF where
-    type PixelBaseComponent PixelRGBF = PixelF
-
-    {-# INLINE mixWith #-}
-    mixWith f (PixelRGBF ra ga ba) (PixelRGBF rb gb bb) =
-        PixelRGBF (f 0 ra rb) (f 1 ga gb) (f 2 ba bb)
-
-    {-# INLINE colorMap #-}
-    colorMap f (PixelRGBF r g b) = PixelRGBF (f r) (f g) (f b)
-
-    componentCount _ = 3
-
-    pixelAt image@(Image { imageData = arr }) x y = PixelRGBF (arr ! (baseIdx + 0))
-                                                              (arr ! (baseIdx + 1))
-                                                              (arr ! (baseIdx + 2))
-        where baseIdx = pixelBaseIndex image x y
-
-    readPixel image@(MutableImage { mutableImageData = arr }) x y = do
-        rv <- arr .!!!. baseIdx
-        gv <- arr .!!!. (baseIdx + 1)
-        bv <- arr .!!!. (baseIdx + 2)
-        return $ PixelRGBF rv gv bv
-        where baseIdx = mutablePixelBaseIndex image x y
-
-    writePixel image@(MutableImage { mutableImageData = arr }) x y (PixelRGBF rv gv bv) = do
-        let baseIdx = mutablePixelBaseIndex image x y
-        (arr .<-. (baseIdx + 0)) rv
-        (arr .<-. (baseIdx + 1)) gv
-        (arr .<-. (baseIdx + 2)) bv
-
-    unsafePixelAt v idx =
-        PixelRGBF (V.unsafeIndex v idx) (V.unsafeIndex v $ idx + 1) (V.unsafeIndex v $ idx + 2)
-    unsafeReadPixel vec idx =
-        PixelRGBF `liftM` M.unsafeRead vec idx
-                  `ap` M.unsafeRead vec (idx + 1)
-                  `ap` M.unsafeRead vec (idx + 2)
-    unsafeWritePixel v idx (PixelRGBF r g b) =
-        M.unsafeWrite v idx r >> M.unsafeWrite v (idx + 1) g
-                              >> M.unsafeWrite v (idx + 2) b
-
-instance ColorPlane PixelRGBF PlaneRed where
-    toComponentIndex _ _ = 0
-
-instance ColorPlane PixelRGBF PlaneGreen where
-    toComponentIndex _ _ = 1
-
-instance ColorPlane PixelRGBF PlaneBlue where
-    toComponentIndex _ _ = 2
-
---------------------------------------------------
-----            PixelRGB16 instances
---------------------------------------------------
-instance Pixel PixelRGB16 where
-    type PixelBaseComponent PixelRGB16 = Pixel16
-
-    {-# INLINE mixWith #-}
-    mixWith f (PixelRGB16 ra ga ba) (PixelRGB16 rb gb bb) =
-        PixelRGB16 (f 0 ra rb) (f 1 ga gb) (f 2 ba bb)
-
-    {-# INLINE colorMap #-}
-    colorMap f (PixelRGB16 r g b) = PixelRGB16 (f r) (f g) (f b)
-
-    componentCount _ = 3
-
-    pixelAt image@(Image { imageData = arr }) x y = PixelRGB16 (arr ! (baseIdx + 0))
-                                                               (arr ! (baseIdx + 1))
-                                                               (arr ! (baseIdx + 2))
-        where baseIdx = pixelBaseIndex image x y
-
-    readPixel image@(MutableImage { mutableImageData = arr }) x y = do
-        rv <- arr .!!!. baseIdx
-        gv <- arr .!!!. (baseIdx + 1)
-        bv <- arr .!!!. (baseIdx + 2)
-        return $ PixelRGB16 rv gv bv
-        where baseIdx = mutablePixelBaseIndex image x y
-
-    writePixel image@(MutableImage { mutableImageData = arr }) x y (PixelRGB16 rv gv bv) = do
-        let baseIdx = mutablePixelBaseIndex image x y
-        (arr .<-. (baseIdx + 0)) rv
-        (arr .<-. (baseIdx + 1)) gv
-        (arr .<-. (baseIdx + 2)) bv
-
-    unsafePixelAt v idx =
-        PixelRGB16 (V.unsafeIndex v idx) (V.unsafeIndex v $ idx + 1) (V.unsafeIndex v $ idx + 2)
-    unsafeReadPixel vec idx =
-        PixelRGB16 `liftM` M.unsafeRead vec idx
-                   `ap` M.unsafeRead vec (idx + 1)
-                   `ap` M.unsafeRead vec (idx + 2)
-    unsafeWritePixel v idx (PixelRGB16 r g b) =
-        M.unsafeWrite v idx r >> M.unsafeWrite v (idx + 1) g
-                              >> M.unsafeWrite v (idx + 2) b
-
-instance ColorPlane PixelRGB16 PlaneRed where
-    toComponentIndex _ _ = 0
-
-instance ColorPlane PixelRGB16 PlaneGreen where
-    toComponentIndex _ _ = 1
-
-instance ColorPlane PixelRGB16 PlaneBlue where
-    toComponentIndex _ _ = 2
-
-instance ColorSpaceConvertible PixelRGB16 PixelCMYK16 where
-    {-# INLINE convertPixel #-}
-    convertPixel (PixelRGB16 r g b) = integralRGBToCMYK PixelCMYK16 (r, g, b)
-
-instance ColorConvertible PixelRGB16 PixelRGBA16 where
-    {-# INLINE promotePixel #-}
-    promotePixel (PixelRGB16 r g b) = PixelRGBA16 r g b maxBound
-
-instance LumaPlaneExtractable PixelRGB16 where
-    {-# INLINE computeLuma #-}
-    computeLuma (PixelRGB16 r g b) = floor $ 0.3 * toRational r +
-                                             0.59 * toRational g +
-                                             0.11 * toRational b
---------------------------------------------------
-----            PixelRGB8 instances
---------------------------------------------------
-instance Pixel PixelRGB8 where
-    type PixelBaseComponent PixelRGB8 = Word8
-
-    {-# INLINE mixWith #-}
-    mixWith f (PixelRGB8 ra ga ba) (PixelRGB8 rb gb bb) =
-        PixelRGB8 (f 0 ra rb) (f 1 ga gb) (f 2 ba bb)
-
-    {-# INLINE colorMap #-}
-    colorMap f (PixelRGB8 r g b) = PixelRGB8 (f r) (f g) (f b)
-
-    componentCount _ = 3
-
-    pixelAt image@(Image { imageData = arr }) x y = PixelRGB8 (arr ! (baseIdx + 0))
-                                                              (arr ! (baseIdx + 1))
-                                                              (arr ! (baseIdx + 2))
-        where baseIdx = pixelBaseIndex image x y
-
-    readPixel image@(MutableImage { mutableImageData = arr }) x y = do
-        rv <- arr .!!!. baseIdx
-        gv <- arr .!!!. (baseIdx + 1)
-        bv <- arr .!!!. (baseIdx + 2)
-        return $ PixelRGB8 rv gv bv
-        where baseIdx = mutablePixelBaseIndex image x y
-
-    writePixel image@(MutableImage { mutableImageData = arr }) x y (PixelRGB8 rv gv bv) = do
-        let baseIdx = mutablePixelBaseIndex image x y
-        (arr .<-. (baseIdx + 0)) rv
-        (arr .<-. (baseIdx + 1)) gv
-        (arr .<-. (baseIdx + 2)) bv
-
-    unsafePixelAt v idx =
-        PixelRGB8 (V.unsafeIndex v idx) (V.unsafeIndex v $ idx + 1) (V.unsafeIndex v $ idx + 2)
-    unsafeReadPixel vec idx =
-        PixelRGB8 `liftM` M.unsafeRead vec idx
-                  `ap` M.unsafeRead vec (idx + 1)
-                  `ap` M.unsafeRead vec (idx + 2)
-    unsafeWritePixel v idx (PixelRGB8 r g b) =
-        M.unsafeWrite v idx r >> M.unsafeWrite v (idx + 1) g
-                              >> M.unsafeWrite v (idx + 2) b
-
-instance ColorConvertible PixelRGB8 PixelRGBA8 where
-    {-# INLINE promotePixel #-}
-    promotePixel (PixelRGB8 r g b) = PixelRGBA8 r g b maxBound
-
-instance ColorConvertible PixelRGB8 PixelRGBF where
-    {-# INLINE promotePixel #-}
-    promotePixel (PixelRGB8 r g b) = PixelRGBF (toF r) (toF g) (toF b)
-        where toF v = fromIntegral v / 255.0
-
-instance ColorPlane PixelRGB8 PlaneRed where
-    toComponentIndex _ _ = 0
-
-instance ColorPlane PixelRGB8 PlaneGreen where
-    toComponentIndex _ _ = 1
-
-instance ColorPlane PixelRGB8 PlaneBlue where
-    toComponentIndex _ _ = 2
-
-instance LumaPlaneExtractable PixelRGB8 where
-    {-# INLINE computeLuma #-}
-    computeLuma (PixelRGB8 r g b) = floor $ 0.3 * toRational r +
-                                            0.59 * toRational g +
-                                            0.11 * toRational b
-
---------------------------------------------------
-----            PixelRGBA8 instances
---------------------------------------------------
-instance Pixel PixelRGBA8 where
-    type PixelBaseComponent PixelRGBA8 = Word8
-
-    {-# INLINE mixWith #-}
-    mixWith f (PixelRGBA8 ra ga ba aa) (PixelRGBA8 rb gb bb ab) =
-        PixelRGBA8 (f 0 ra rb) (f 1 ga gb) (f 2 ba bb) (f 3 aa ab)
-
-    {-# INLINE colorMap #-}
-    colorMap f (PixelRGBA8 r g b a) = PixelRGBA8 (f r) (f g) (f b) (f a)
-
-    componentCount _ = 4
-
-    pixelAt image@(Image { imageData = arr }) x y = PixelRGBA8 (arr ! (baseIdx + 0))
-                                                               (arr ! (baseIdx + 1))
-                                                               (arr ! (baseIdx + 2))
-                                                               (arr ! (baseIdx + 3))
-        where baseIdx = pixelBaseIndex image x y
-
-    readPixel image@(MutableImage { mutableImageData = arr }) x y = do
-        rv <- arr .!!!. baseIdx
-        gv <- arr .!!!. (baseIdx + 1)
-        bv <- arr .!!!. (baseIdx + 2)
-        av <- arr .!!!. (baseIdx + 3)
-        return $ PixelRGBA8 rv gv bv av
-        where baseIdx = mutablePixelBaseIndex image x y
-
-    writePixel image@(MutableImage { mutableImageData = arr }) x y (PixelRGBA8 rv gv bv av) = do
-        let baseIdx = mutablePixelBaseIndex image x y
-        (arr .<-. (baseIdx + 0)) rv
-        (arr .<-. (baseIdx + 1)) gv
-        (arr .<-. (baseIdx + 2)) bv
-        (arr .<-. (baseIdx + 3)) av
-
-    unsafePixelAt v idx =
-        PixelRGBA8 (V.unsafeIndex v idx)
-                   (V.unsafeIndex v $ idx + 1)
-                   (V.unsafeIndex v $ idx + 2)
-                   (V.unsafeIndex v $ idx + 3)
-    unsafeReadPixel vec idx =
-        PixelRGBA8 `liftM` M.unsafeRead vec idx
-                   `ap` M.unsafeRead vec (idx + 1)
-                   `ap` M.unsafeRead vec (idx + 2)
-                   `ap` M.unsafeRead vec (idx + 3)
-    unsafeWritePixel v idx (PixelRGBA8 r g b a) =
-        M.unsafeWrite v idx r >> M.unsafeWrite v (idx + 1) g
-                              >> M.unsafeWrite v (idx + 2) b
-                              >> M.unsafeWrite v (idx + 3) a
-
-instance ColorPlane PixelRGBA8 PlaneRed where
-    toComponentIndex _ _ = 0
-
-instance ColorPlane PixelRGBA8 PlaneGreen where
-    toComponentIndex _ _ = 1
-
-instance ColorPlane PixelRGBA8 PlaneBlue where
-    toComponentIndex _ _ = 2
-
-instance ColorPlane PixelRGBA8 PlaneAlpha where
-    toComponentIndex _ _ = 3
-
---------------------------------------------------
-----            PixelRGBA16 instances
---------------------------------------------------
-instance Pixel PixelRGBA16 where
-    type PixelBaseComponent PixelRGBA16 = Pixel16
-
-    {-# INLINE mixWith #-}
-    mixWith f (PixelRGBA16 ra ga ba aa) (PixelRGBA16 rb gb bb ab) =
-        PixelRGBA16 (f 0 ra rb) (f 1 ga gb) (f 2 ba bb) (f 3 aa ab)
-
-    {-# INLINE colorMap #-}
-    colorMap f (PixelRGBA16 r g b a) = PixelRGBA16 (f r) (f g) (f b) (f a)
-
-    componentCount _ = 4
-
-    pixelAt image@(Image { imageData = arr }) x y =
-                PixelRGBA16 (arr ! (baseIdx + 0)) (arr ! (baseIdx + 1))
-                            (arr ! (baseIdx + 2)) (arr ! (baseIdx + 3))
-        where baseIdx = pixelBaseIndex image x y
-
-    readPixel image@(MutableImage { mutableImageData = arr }) x y = do
-        rv <- arr .!!!. baseIdx
-        gv <- arr .!!!. (baseIdx + 1)
-        bv <- arr .!!!. (baseIdx + 2)
-        av <- arr .!!!. (baseIdx + 3)
-        return $ PixelRGBA16 rv gv bv av
-        where baseIdx = mutablePixelBaseIndex image x y
-
-    writePixel image@(MutableImage { mutableImageData = arr }) x y (PixelRGBA16 rv gv bv av) = do
-        let baseIdx = mutablePixelBaseIndex image x y
-        (arr .<-. (baseIdx + 0)) rv
-        (arr .<-. (baseIdx + 1)) gv
-        (arr .<-. (baseIdx + 2)) bv
-        (arr .<-. (baseIdx + 3)) av
-
-    unsafePixelAt v idx =
-        PixelRGBA16 (V.unsafeIndex v idx)
-                    (V.unsafeIndex v $ idx + 1)
-                    (V.unsafeIndex v $ idx + 2)
-                    (V.unsafeIndex v $ idx + 3)
-    unsafeReadPixel vec idx =
-        PixelRGBA16 `liftM` M.unsafeRead vec idx
-                    `ap` M.unsafeRead vec (idx + 1)
-                    `ap` M.unsafeRead vec (idx + 2)
-                    `ap` M.unsafeRead vec (idx + 3)
-    unsafeWritePixel v idx (PixelRGBA16 r g b a) =
-        M.unsafeWrite v idx r >> M.unsafeWrite v (idx + 1) g
-                              >> M.unsafeWrite v (idx + 2) b
-                              >> M.unsafeWrite v (idx + 3) a
-
-
-instance TransparentPixel PixelRGBA16 PixelRGB16 where
-    {-# INLINE dropTransparency #-}
-    dropTransparency (PixelRGBA16 r g b _) = PixelRGB16 r g b
-
-instance ColorPlane PixelRGBA16 PlaneRed where
-    toComponentIndex _ _ = 0
-
-instance ColorPlane PixelRGBA16 PlaneGreen where
-    toComponentIndex _ _ = 1
-
-instance ColorPlane PixelRGBA16 PlaneBlue where
-    toComponentIndex _ _ = 2
-
-instance ColorPlane PixelRGBA16 PlaneAlpha where
-    toComponentIndex _ _ = 3
-
---------------------------------------------------
-----            PixelYCbCr8 instances
---------------------------------------------------
-instance Pixel PixelYCbCr8 where
-    type PixelBaseComponent PixelYCbCr8 = Word8
-
-    {-# INLINE mixWith #-}
-    mixWith f (PixelYCbCr8 ya cba cra) (PixelYCbCr8 yb cbb crb) =
-        PixelYCbCr8 (f 0 ya yb) (f 1 cba cbb) (f 2 cra crb)
-
-    {-# INLINE colorMap #-}
-    colorMap f (PixelYCbCr8 y cb cr) = PixelYCbCr8 (f y) (f cb) (f cr)
-    componentCount _ = 3
-    pixelAt image@(Image { imageData = arr }) x y = PixelYCbCr8 (arr ! (baseIdx + 0))
-                                                                (arr ! (baseIdx + 1))
-                                                                (arr ! (baseIdx + 2))
-        where baseIdx = pixelBaseIndex image x y
-
-    readPixel image@(MutableImage { mutableImageData = arr }) x y = do
-        yv <- arr .!!!. baseIdx
-        cbv <- arr .!!!. (baseIdx + 1)
-        crv <- arr .!!!. (baseIdx + 2)
-        return $ PixelYCbCr8 yv cbv crv
-        where baseIdx = mutablePixelBaseIndex image x y
-
-    writePixel image@(MutableImage { mutableImageData = arr }) x y (PixelYCbCr8 yv cbv crv) = do
-        let baseIdx = mutablePixelBaseIndex image x y
-        (arr .<-. (baseIdx + 0)) yv
-        (arr .<-. (baseIdx + 1)) cbv
-        (arr .<-. (baseIdx + 2)) crv
-
-    unsafePixelAt v idx =
-        PixelYCbCr8 (V.unsafeIndex v idx) (V.unsafeIndex v $ idx + 1) (V.unsafeIndex v $ idx + 2)
-    unsafeReadPixel vec idx =
-        PixelYCbCr8 `liftM` M.unsafeRead vec idx
-                    `ap` M.unsafeRead vec (idx + 1)
-                    `ap` M.unsafeRead vec (idx + 2)
-    unsafeWritePixel v idx (PixelYCbCr8 y cb cr) =
-        M.unsafeWrite v idx y >> M.unsafeWrite v (idx + 1) cb
-                              >> M.unsafeWrite v (idx + 2) cr
-
-instance (Pixel a) => ColorSpaceConvertible a a where
-    convertPixel = id
-    convertImage = id
-
-scaleBits, oneHalf :: Int
-scaleBits = 16
-oneHalf = 1 `unsafeShiftL` (scaleBits - 1)
-
-fix :: Float -> Int
-fix x = floor $ x * fromIntegral ((1 :: Int) `unsafeShiftL` scaleBits) + 0.5
-
-
-rYTab, gYTab, bYTab, rCbTab, gCbTab, bCbTab, gCrTab, bCrTab :: V.Vector Int
-rYTab = V.fromListN 256 [fix 0.29900 * i | i <- [0..255] ]
-gYTab = V.fromListN 256 [fix 0.58700 * i | i <- [0..255] ]
-bYTab = V.fromListN 256 [fix 0.11400 * i + oneHalf | i <- [0..255] ]
-rCbTab = V.fromListN 256 [(- fix 0.16874) * i | i <- [0..255] ]
-gCbTab = V.fromListN 256 [(- fix 0.33126) * i | i <- [0..255] ]
-bCbTab = V.fromListN 256 [fix 0.5 * i + (128 `unsafeShiftL` scaleBits) + oneHalf - 1| i <- [0..255] ]
-gCrTab = V.fromListN 256 [(- fix 0.41869) * i | i <- [0..255] ]
-bCrTab = V.fromListN 256 [(- fix 0.08131) * i | i <- [0..255] ]
-
-
-instance ColorSpaceConvertible PixelRGB8 PixelYCbCr8 where
-    {-# INLINE convertPixel #-}
-    convertPixel (PixelRGB8 r g b) = PixelYCbCr8 (fromIntegral y) (fromIntegral cb) (fromIntegral cr)
-      where ri = fromIntegral r
-            gi = fromIntegral g
-            bi = fromIntegral b
-
-            y  = (rYTab `V.unsafeIndex` ri + gYTab `V.unsafeIndex` gi + bYTab `V.unsafeIndex` bi) `unsafeShiftR` scaleBits
-            cb = (rCbTab `V.unsafeIndex` ri + gCbTab `V.unsafeIndex` gi + bCbTab `V.unsafeIndex` bi) `unsafeShiftR` scaleBits
-            cr = (bCbTab `V.unsafeIndex` ri + gCrTab `V.unsafeIndex` gi + bCrTab `V.unsafeIndex` bi) `unsafeShiftR` scaleBits
-
-    convertImage Image { imageWidth = w, imageHeight = h, imageData = d } = Image w h newData
-        where maxi = w * h
-
-              rY  = fix 0.29900
-              gY  = fix 0.58700
-              bY  = fix 0.11400
-              rCb = (- fix 0.16874)
-              gCb = (- fix 0.33126)
-              bCb = fix 0.5
-              gCr = (- fix 0.41869)
-              bCr = (- fix 0.08131)
-
-              newData = runST $ do
-                block <- M.new $ maxi * 3
-                let traductor _ idx | idx >= maxi = return block
-                    traductor readIdx idx = do
-                        let ri = fromIntegral $ d `V.unsafeIndex` readIdx
-                            gi = fromIntegral $ d `V.unsafeIndex` (readIdx + 1)
-                            bi = fromIntegral $ d `V.unsafeIndex` (readIdx + 2)
-
-                            y  = (rY * ri + gY * gi + bY * bi + oneHalf) `unsafeShiftR` scaleBits
-                            cb = (rCb * ri + gCb * gi + bCb * bi + (128 `unsafeShiftL` scaleBits) + oneHalf - 1) `unsafeShiftR` scaleBits
-                            cr = (bCb * ri + (128 `unsafeShiftL` scaleBits) + oneHalf - 1+ gCr * gi + bCr * bi) `unsafeShiftR` scaleBits
-
-                        (block `M.unsafeWrite` (readIdx + 0)) $ fromIntegral y
-                        (block `M.unsafeWrite` (readIdx + 1)) $ fromIntegral cb
-                        (block `M.unsafeWrite` (readIdx + 2)) $ fromIntegral cr
-                        traductor (readIdx + 3) (idx + 1)
-
-                traductor 0 0 >>= V.freeze
-
-crRTab, cbBTab, crGTab, cbGTab :: V.Vector Int
-crRTab = V.fromListN 256 [(fix 1.40200 * x + oneHalf) `unsafeShiftR` scaleBits | x <- [-128 .. 127]]
-cbBTab = V.fromListN 256 [(fix 1.77200 * x + oneHalf) `unsafeShiftR` scaleBits | x <- [-128 .. 127]]
-crGTab = V.fromListN 256 [negate (fix 0.71414) * x | x <- [-128 .. 127]]
-cbGTab = V.fromListN 256 [negate (fix 0.34414) * x + oneHalf | x <- [-128 .. 127]]
-
-instance ColorSpaceConvertible PixelYCbCr8 PixelRGB8 where
-    {-# INLINE convertPixel #-}
-    convertPixel (PixelYCbCr8 y cb cr) = PixelRGB8 (clampWord8 r) (clampWord8 g) (clampWord8 b)
-        where clampWord8 = fromIntegral . max 0 . min 255
-              yi = fromIntegral y
-              cbi = fromIntegral cb
-              cri = fromIntegral cr
-
-              r = yi +  crRTab `V.unsafeIndex` cri
-              g = yi + (cbGTab `V.unsafeIndex` cbi + crGTab `V.unsafeIndex` cri) `unsafeShiftR` scaleBits
-              b = yi +  cbBTab `V.unsafeIndex` cbi
-
-    convertImage Image { imageWidth = w, imageHeight = h, imageData = d } = Image w h newData
-        where maxi = w * h
-              clampWord8 v | v < 0 = 0
-                           | v > 255 = 255
-                           | otherwise = fromIntegral v
-
-              newData = runST $ do
-                block <- M.new $ maxi * 3
-                let traductor _ idx | idx >= maxi = return block
-                    traductor readIdx idx = do
-                        let yi =  fromIntegral $ d `V.unsafeIndex` readIdx
-                            cbi = fromIntegral $ d `V.unsafeIndex` (readIdx + 1)
-                            cri = fromIntegral $ d `V.unsafeIndex` (readIdx + 2)
-
-                            r = yi +  crRTab `V.unsafeIndex` cri
-                            g = yi + (cbGTab `V.unsafeIndex` cbi + crGTab `V.unsafeIndex` cri) `unsafeShiftR` scaleBits
-                            b = yi +  cbBTab `V.unsafeIndex` cbi
-
-                        (block `M.unsafeWrite` (readIdx + 0)) $ clampWord8 r
-                        (block `M.unsafeWrite` (readIdx + 1)) $ clampWord8 g
-                        (block `M.unsafeWrite` (readIdx + 2)) $ clampWord8 b
-                        traductor (readIdx + 3) (idx + 1)
-
-                traductor 0 0 >>= V.freeze
-
-instance ColorPlane PixelYCbCr8 PlaneLuma where
-    toComponentIndex _ _ = 0
-
-instance ColorPlane PixelYCbCr8 PlaneCb where
-    toComponentIndex _ _ = 1
-
-instance ColorPlane PixelYCbCr8 PlaneCr where
-    toComponentIndex _ _ = 2
-
---------------------------------------------------
-----            PixelCMYK8 instances
---------------------------------------------------
-instance Pixel PixelCMYK8 where
-    type PixelBaseComponent PixelCMYK8 = Word8
-
-    {-# INLINE mixWith #-}
-    mixWith f (PixelCMYK8 ca ma ya ka) (PixelCMYK8 cb mb yb kb) =
-        PixelCMYK8 (f 0 ca cb) (f 1 ma mb) (f 2 ya yb) (f 3 ka kb)
-
-    {-# INLINE colorMap #-}
-    colorMap f (PixelCMYK8 c m y k) = PixelCMYK8 (f c) (f m) (f y) (f k)
-
-    componentCount _ = 4
-
-    pixelAt image@(Image { imageData = arr }) x y = PixelCMYK8 (arr ! (baseIdx + 0))
-                                                               (arr ! (baseIdx + 1))
-                                                               (arr ! (baseIdx + 2))
-                                                               (arr ! (baseIdx + 3))
-        where baseIdx = pixelBaseIndex image x y
-
-    readPixel image@(MutableImage { mutableImageData = arr }) x y = do
-        rv <- arr .!!!. baseIdx
-        gv <- arr .!!!. (baseIdx + 1)
-        bv <- arr .!!!. (baseIdx + 2)
-        av <- arr .!!!. (baseIdx + 3)
-        return $ PixelCMYK8 rv gv bv av
-        where baseIdx = mutablePixelBaseIndex image x y
-
-    writePixel image@(MutableImage { mutableImageData = arr }) x y (PixelCMYK8 rv gv bv av) = do
-        let baseIdx = mutablePixelBaseIndex image x y
-        (arr .<-. (baseIdx + 0)) rv
-        (arr .<-. (baseIdx + 1)) gv
-        (arr .<-. (baseIdx + 2)) bv
-        (arr .<-. (baseIdx + 3)) av
-
-    unsafePixelAt v idx =
-        PixelCMYK8 (V.unsafeIndex v idx)
-                   (V.unsafeIndex v $ idx + 1)
-                   (V.unsafeIndex v $ idx + 2)
-                   (V.unsafeIndex v $ idx + 3)
-    unsafeReadPixel vec idx =
-        PixelCMYK8 `liftM` M.unsafeRead vec idx
-                   `ap` M.unsafeRead vec (idx + 1)
-                   `ap` M.unsafeRead vec (idx + 2)
-                   `ap` M.unsafeRead vec (idx + 3)
-    unsafeWritePixel v idx (PixelCMYK8 r g b a) =
-        M.unsafeWrite v idx r >> M.unsafeWrite v (idx + 1) g
-                              >> M.unsafeWrite v (idx + 2) b
-                              >> M.unsafeWrite v (idx + 3) a
-
-instance ColorSpaceConvertible PixelCMYK8 PixelRGB8 where
-  convertPixel (PixelCMYK8 c m y k) =
-      PixelRGB8 (clampWord8 r) (clampWord8 g) (clampWord8 b)
-    where
-          clampWord8 = fromIntegral . (`unsafeShiftR` 8)
-          ik :: Int
-          ik = 255 - fromIntegral k
-
-          r = (255 - fromIntegral c) * ik
-          g = (255 - fromIntegral m) * ik
-          b = (255 - fromIntegral y) * ik
-
-
-{-# SPECIALIZE integralRGBToCMYK :: (Word8 -> Word8 -> Word8 -> Word8 -> b)
-                                 -> (Word8, Word8, Word8) -> b #-}
-{-# SPECIALIZE integralRGBToCMYK :: (Word16 -> Word16 -> Word16 -> Word16 -> b)
-                                 -> (Word16, Word16, Word16) -> b #-}
-integralRGBToCMYK :: (Bounded a, Integral a)
-                  => (a -> a -> a -> a -> b)    -- ^ Pixel building function
-                  -> (a, a, a)                  -- ^ RGB sample
-                  -> b                          -- ^ Resulting sample
-integralRGBToCMYK build (r, g, b) =
-  build (clamp c) (clamp m) (clamp y) (fromIntegral kInt)
-    where maxi = maxBound
-
-          ir = fromIntegral $ maxi - r :: Int
-          ig = fromIntegral $ maxi - g
-          ib = fromIntegral $ maxi - b
-
-          kInt = minimum [ir, ig, ib]
-          ik = fromIntegral maxi - kInt
-
-          c = (ir - kInt) `div` ik
-          m = (ig - kInt) `div` ik
-          y = (ib - kInt) `div` ik
-
-          clamp = fromIntegral . (max 0)
-
-instance ColorSpaceConvertible PixelRGB8 PixelCMYK8 where
-  convertPixel (PixelRGB8 r g b) = integralRGBToCMYK PixelCMYK8 (r, g, b)
-
-instance ColorPlane PixelCMYK8 PlaneCyan where
-    toComponentIndex _ _ = 0
-
-instance ColorPlane PixelCMYK8 PlaneMagenta where
-    toComponentIndex _ _ = 1
-
-instance ColorPlane PixelCMYK8 PlaneYellow where
-    toComponentIndex _ _ = 2
-
-instance ColorPlane PixelCMYK8 PlaneBlack where
-    toComponentIndex _ _ = 3
-
---------------------------------------------------
-----            PixelCMYK16 instances
---------------------------------------------------
-instance Pixel PixelCMYK16 where
-    type PixelBaseComponent PixelCMYK16 = Word16
-
-    {-# INLINE mixWith #-}
-    mixWith f (PixelCMYK16 ca ma ya ka) (PixelCMYK16 cb mb yb kb) =
-        PixelCMYK16 (f 0 ca cb) (f 1 ma mb) (f 2 ya yb) (f 3 ka kb)
-
-    {-# INLINE colorMap #-}
-    colorMap f (PixelCMYK16 c m y k) = PixelCMYK16 (f c) (f m) (f y) (f k)
-
-    componentCount _ = 4
-
-    pixelAt image@(Image { imageData = arr }) x y = PixelCMYK16 (arr ! (baseIdx + 0))
-                                                               (arr ! (baseIdx + 1))
-                                                               (arr ! (baseIdx + 2))
-                                                               (arr ! (baseIdx + 3))
-        where baseIdx = pixelBaseIndex image x y
-
-    readPixel image@(MutableImage { mutableImageData = arr }) x y = do
-        rv <- arr .!!!. baseIdx
-        gv <- arr .!!!. (baseIdx + 1)
-        bv <- arr .!!!. (baseIdx + 2)
-        av <- arr .!!!. (baseIdx + 3)
-        return $ PixelCMYK16 rv gv bv av
-        where baseIdx = mutablePixelBaseIndex image x y
-
-    writePixel image@(MutableImage { mutableImageData = arr }) x y (PixelCMYK16 rv gv bv av) = do
-        let baseIdx = mutablePixelBaseIndex image x y
-        (arr .<-. (baseIdx + 0)) rv
-        (arr .<-. (baseIdx + 1)) gv
-        (arr .<-. (baseIdx + 2)) bv
-        (arr .<-. (baseIdx + 3)) av
-
-    unsafePixelAt v idx =
-        PixelCMYK16 (V.unsafeIndex v idx)
-                   (V.unsafeIndex v $ idx + 1)
-                   (V.unsafeIndex v $ idx + 2)
-                   (V.unsafeIndex v $ idx + 3)
-    unsafeReadPixel vec idx =
-        PixelCMYK16 `liftM` M.unsafeRead vec idx
-                   `ap` M.unsafeRead vec (idx + 1)
-                   `ap` M.unsafeRead vec (idx + 2)
-                   `ap` M.unsafeRead vec (idx + 3)
-    unsafeWritePixel v idx (PixelCMYK16 r g b a) =
-        M.unsafeWrite v idx r >> M.unsafeWrite v (idx + 1) g
-                              >> M.unsafeWrite v (idx + 2) b
-                              >> M.unsafeWrite v (idx + 3) a
-
-instance ColorSpaceConvertible PixelCMYK16 PixelRGB16 where
-  convertPixel (PixelCMYK16 c m y k) =
-      PixelRGB16 (clampWord16 r) (clampWord16 g) (clampWord16 b)
-    where
-          clampWord16 = fromIntegral . (`unsafeShiftR` 16)
-          ik :: Int
-          ik = 65535 - fromIntegral k
-
-          r = (65535 - fromIntegral c) * ik
-          g = (65535 - fromIntegral m) * ik
-          b = (65535 - fromIntegral y) * ik
-
-instance ColorPlane PixelCMYK16 PlaneCyan where
-    toComponentIndex _ _ = 0
-
-instance ColorPlane PixelCMYK16 PlaneMagenta where
-    toComponentIndex _ _ = 1
-
-instance ColorPlane PixelCMYK16 PlaneYellow where
-    toComponentIndex _ _ = 2
-
-instance ColorPlane PixelCMYK16 PlaneBlack where
-    toComponentIndex _ _ = 3
-
--- | Perform a gamma correction for an image with HDR pixels.
-gammaCorrection :: PixelF          -- ^ Gamma value, should be between 0.5 and 3.0
-                -> Image PixelRGBF -- ^ Image to treat.
-                -> Image PixelRGBF
-gammaCorrection gammaVal = pixelMap gammaCorrector
-  where gammaExponent = 1.0 / gammaVal
-        fixVal v = v ** gammaExponent
-        gammaCorrector (PixelRGBF r g b) =
-            PixelRGBF (fixVal r) (fixVal g) (fixVal b)
-
--- | Perform a tone mapping operation on an High dynamic range image.
-toneMapping :: PixelF          -- ^ Exposure parameter
-            -> Image PixelRGBF -- ^ Image to treat.
-            -> Image PixelRGBF
-toneMapping exposure img = Image (imageWidth img) (imageHeight img) scaledData
- where coeff = exposure * (exposure / maxBrightness + 1.0) / (exposure + 1.0);
-       maxBrightness = pixelFold (\luma _ _ px -> max luma $ computeLuma px) 0 img
-       scaledData = V.map (* coeff) $ imageData img
-