JuicyPixels 1.0 → 1.1

raw patch · 10 files changed

+257/−127 lines, 10 filesdep +primitivedep +vectorPVP ok

version bump matches the API change (PVP)

Dependencies added: primitive, vector

API changes (from Hackage documentation)

Files

• Codec/Picture.hs +2/−1
• Codec/Picture/Bitmap.hs +17/−15
• Codec/Picture/Jpg.hs +20/−18
• Codec/Picture/Jpg/DefaultTable.hs +5/−4
• Codec/Picture/Jpg/FastIdct.hs +28/−20
• Codec/Picture/Png.hs +44/−40
• Codec/Picture/Png/Export.hs +1/−1
• Codec/Picture/Png/Type.hs +4/−3
• Codec/Picture/Types.hs +131/−22
• JuicyPixels.cabal +5/−3

@@ -36,7 +36,7 @@ 
                      -- * Image types and pixel types
                      -- ** Image
-                     , Image
+                     , Image( .. )
                      , DynamicImage( .. )
                      -- ** Pixels
                      , Pixel( .. )
@@ -76,5 +76,6 @@ decodeImage :: B.ByteString -> Either String DynamicImage
 decodeImage str = eitherLoad str [("Jpeg", decodeJpeg)
                                  ,("PNG", decodePng)
+                                 ,("Bitmap", decodeBitmap)
                                  ]
     

@@ -12,16 +12,18 @@                              -- * Accepted formt in output
                            , BmpEncodable( )
                            ) where
+import Foreign.Storable ( Storable )
 import Control.Monad( when, forM_ )
-import Data.Array.Base( unsafeAt, unsafeWrite )
-import Data.Array.Unboxed( IArray )
+import Control.Monad.ST ( runST )
+import Control.Monad.Primitive ( PrimMonad, PrimState )
+import qualified Data.Vector.Storable as V
+import qualified Data.Vector.Storable.Mutable as M
 import Data.Serialize( Serialize( .. )
                      , putWord8, putWord16le, putWord32le
                      , getWord16le, getWord32le
                      , Get, Put, runGet, runPut
                      , remaining, getBytes )
 import Data.Word( Word32, Word16, Word8 )
-import Data.Array.ST( MArray, runSTUArray, newArray )
 import qualified Data.ByteString as B
 
 import Codec.Picture.Types
@@ -134,8 +136,8 @@     defaultPalette _ = BmpPalette []
 
 {-# INLINE (!!!) #-}
-(!!!) :: (IArray array e) => array Int e -> Int -> e
-(!!!) = unsafeAt -- (!)
+(!!!) :: (Storable e) => V.Vector e -> Int -> e
+(!!!) = V.unsafeIndex
 
 {-# INLINE stridePut #-}
 stridePut :: Int -> Put
@@ -192,17 +194,17 @@                   putLine (line - 1)
 
 {-# INLINE (.<-.) #-}
-(.<-.) :: (MArray array e m) => array Int e -> Int -> e -> m ()
-(.<-.) = unsafeWrite
+(.<-.) :: (PrimMonad m, Storable a) => M.STVector (PrimState m) a -> Int -> a -> m ()
+(.<-.) = M.unsafeWrite
 
 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 = runSTUArray $ do
-            arr <- newArray (0, fromIntegral $ w * h * 3) 128
+        stArray = runST $ do
+            arr <- M.replicate (fromIntegral $ w * h * 3) 128
             forM_ [hi - 1, hi - 2 .. 0] (readLine arr)
-            return arr
+            V.unsafeFreeze arr
 
         stride = linePadding 24 wi
         readLine arr line =
@@ -227,8 +229,8 @@ --
 decodeBitmap :: B.ByteString -> Either String DynamicImage
 decodeBitmap str = flip runGet str $ do
-  _hdr      <- (get :: Get BmpHeader)
-  bmpHeader <- (get :: Get BmpInfoHeader)
+  _hdr      <- get :: Get BmpHeader
+  bmpHeader <- get :: Get BmpInfoHeader
   case (bitPerPixel bmpHeader, planes  bmpHeader,
               bitmapCompression bmpHeader) of
     -- (32, 1, 0) -> {- ImageRGBA8 <$>-} fail "Meuh"
@@ -297,10 +299,10 @@ 
           info = BmpInfoHeader {
               size = sizeofBmpInfo,
-              width = fromIntegral $ imgWidth,
-              height = fromIntegral $ imgHeight,
+              width = fromIntegral imgWidth,
+              height = fromIntegral imgHeight,
               planes = 1,
-              bitPerPixel = fromIntegral $ bpp,
+              bitPerPixel = fromIntegral bpp,
               bitmapCompression = 0, -- no compression
               byteImageSize = imagePixelSize,
               xResolution = 0,

@@ -7,11 +7,11 @@ 
 import Control.Applicative( (<$>), (<*>))
 import Control.Monad( when, replicateM, forM, forM_, foldM_, unless )
-import Control.Monad.ST( ST )
+import Control.Monad.ST( ST, runST )
 import Control.Monad.Trans( lift )
+import Control.Monad.Primitive ( PrimState, PrimMonad )
 import qualified Control.Monad.Trans.State.Strict as S
 
-import Data.Array.Base( unsafeAt, unsafeRead, unsafeWrite )
 import Data.List( find, foldl' )
 import Data.Bits( (.|.), (.&.), shiftL, shiftR )
 import Data.Int( Int16, Int32 )
@@ -22,9 +22,11 @@                      , remaining, lookAhead, skip
                      , getBytes, decode )
 import Data.Maybe( fromJust )
-import Data.Array.Unboxed( IArray, Array, UArray, elems, listArray)
-import Data.Array.ST( STUArray, MArray, newArray, runSTUArray )
+import qualified Data.Vector.Storable as V
+import qualified Data.Vector.Storable.Mutable as M
+import Data.Array.Unboxed( Array, UArray, elems, listArray)
 import qualified Data.ByteString as B
+import Foreign.Storable ( Storable )
 
 import Codec.Picture.Types
 import Codec.Picture.Jpg.DefaultTable
@@ -157,7 +159,7 @@     put table = do
         let precision = quantPrecision table
         put4BitsOfEach precision (quantDestination table)
-        forM_ (elems $ quantTable table) $ \coeff ->
+        forM_ (V.toList $ quantTable table) $ \coeff ->
             if precision == 0 then putWord8 $ fromIntegral coeff
                              else putWord16be $ fromIntegral coeff
 
@@ -169,7 +171,7 @@         return JpgQuantTableSpec
             { quantPrecision = precision
             , quantDestination = dest
-            , quantTable = listArray (0, 63) coeffs
+            , quantTable = V.fromListN 64 coeffs
             }
 
 data JpgHuffmanTableSpec = JpgHuffmanTableSpec
@@ -458,16 +460,16 @@ type BoolReader s a = S.StateT BoolState (ST s) a
 
 {-# INLINE (!!!) #-}
-(!!!) :: (IArray array e) => array Int e -> Int -> e
-(!!!) = unsafeAt
+(!!!) :: (Storable e) => V.Vector e -> Int -> e
+(!!!) = V.unsafeIndex
 
 {-# INLINE (.!!!.) #-}
-(.!!!.) :: (MArray array e m) => array Int e -> Int -> m e
-(.!!!.) = unsafeRead
+(.!!!.) :: (PrimMonad m, Storable a) => M.STVector (PrimState m) a -> Int -> m a
+(.!!!.) = M.unsafeRead
 
 {-# INLINE (.<-.) #-}
-(.<-.) :: (MArray array e m) => array Int e -> Int -> e -> m ()
-(.<-.)  = unsafeWrite
+(.<-.) :: (PrimMonad m, Storable a) => M.STVector (PrimState m) a -> Int -> a -> m ()
+(.<-.) = M.unsafeWrite
 
 -- | Apply a quantization matrix to a macroblock
 {-# INLINE deQuantize #-}
@@ -502,7 +504,7 @@ 
 zigZagReorder :: MutableMacroBlock s Int16 -> ST s (MutableMacroBlock s Int16)
 zigZagReorder block = do
-    zigzaged <- newArray (0, 63) 0
+    zigzaged <- M.replicate 64 0
     let update i =  do
             let idx = zigZagOrder !!! i
             v <- block .!!!. fromIntegral idx
@@ -619,7 +621,7 @@ unpackMacroBlock compCount compIdx  wCoeff hCoeff x y 
                  (MutableImage { mutableImageWidth = imgWidth,
                                  mutableImageHeight = imgHeight, mutableImageData = img })
-                 block = do
+                 block =
   forM_ pixelIndices $ \(i, j, wDup, hDup) -> do
       let xPos = (i + x * 8) * wCoeff + wDup
           yPos = (j + y * 8) * hCoeff + hDup
@@ -664,7 +666,7 @@ 
         folder f = foldM_ f blockBeforeRestart blockIndices
 
-    dcArray <- lift (newArray (0, compCount - 1) 0  :: ST s (STUArray s Int DcCoefficient))
+    dcArray <- lift (M.replicate compCount 0  :: ST s (M.STVector s DcCoefficient))
     folder (\resetCounter (x,y) -> do
         when (resetCounter == 0)
              (do forM_ [0.. compCount - 1] $
@@ -808,10 +810,10 @@             imgWidth = fromIntegral $ jpgWidth scanInfo
             imgHeight = fromIntegral $ jpgHeight scanInfo
 
-            imageSize = (0, imgWidth * imgHeight * compCount - 1)
+            imageSize = imgWidth * imgHeight * compCount
 
-            pixelData = runSTUArray $ S.evalStateT (do
-                resultImage <- lift $ newArray imageSize 0
+            pixelData = runST $ V.unsafeFreeze =<< S.evalStateT (do
+                resultImage <- lift $ M.replicate imageSize 0
                 let wrapped = MutableImage imgWidth imgHeight resultImage
                 setDecodedString imgData
                 decodeImage compCount (buildJpegImageDecoder img) wrapped

@@ -17,7 +17,8 @@                                      -}
 									 ) where
 
-import Data.Array.Unboxed( IArray, UArray, listArray )
+import Foreign.Storable ( Storable )
+import qualified Data.Vector.Storable as V
 import Data.Word( Word8 )
 import Data.List( foldl' )
 
@@ -30,11 +31,11 @@ -- | 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 = UArray Int a
+type MacroBlock a = V.Vector a
 
 -- | Helper function to create pure macro block of the good size.
-makeMacroBlock :: (IArray UArray a) => [a] -> MacroBlock a
-makeMacroBlock = listArray (0, 63)
+makeMacroBlock :: (Storable a) => [a] -> MacroBlock a
+makeMacroBlock = V.fromListN 64
 
 -- | Enumeration used to search in the tables for different components.
 data DctComponent = DcComponent | AcComponent

@@ -18,21 +18,28 @@                                  , createEmptyMutableMacroBlock
                                  ) where
 
-import Data.Array.Base( IArray, UArray, unsafeAt
-                      , unsafeRead, unsafeWrite, listArray )
-import Data.Array.ST( MArray, STUArray, newArray )
+import qualified Data.Vector.Storable as V
+import qualified Data.Vector.Storable.Mutable as M
 import Control.Monad( forM_ )
 import Control.Monad.ST( ST )
+import Control.Monad.Primitive ( PrimMonad, PrimState)
 import Data.Bits( shiftL, shiftR )
 import Data.Int( Int16 )
-
-iclip :: UArray Int Int16
-iclip = listArray (-512, 512) [ val i| i <- [(-512) .. 511]]
-    where val i | i < (-256) = -256
-                | i > 255     = 255
-                | otherwise   = i
+import Foreign.Storable ( Storable )
 
+{-
+{-# INLINE iclip #-}
+iclip :: Int -> Int16
+iclip i | fromIntegral i < (-256) = -256
+        | fromIntegral i >   256  =  256
+        | otherwise               =  fromIntegral i
+-}
 
+iclip :: V.Vector Int16
+iclip = V.fromListN 1024 [ val i| i <- [(-512) .. 511] ]
+    where val i | i < (-256) = -256
+                | i > 255    =  255
+                | otherwise  =  i
 
 {-# INLINE (.<<.) #-}
 {-# INLINE (.>>.) #-}
@@ -60,25 +67,26 @@ w6 = 1108 -- 2048*sqrt(2)*cos(6*pi/16)
 w7 = 565  -- 2048*sqrt(2)*cos(7*pi/16)
 
+
 {-# INLINE (!!!) #-}
-(!!!) :: (IArray array e) => array Int e -> Int -> e
-(!!!) a i = unsafeAt a (i + 512)
+(!!!) :: (Storable e) => V.Vector e -> Int -> e
+(!!!) a i = V.unsafeIndex a (i + 512)
 
 {-# INLINE (.!!!.) #-}
-(.!!!.) :: (MArray array e m) => array Int e -> Int -> m e
-(.!!!.) = unsafeRead
+(.!!!.) :: (PrimMonad m, Storable a) => M.STVector (PrimState m) a -> Int -> m a
+(.!!!.) = M.unsafeRead
 
 {-# INLINE (.<-.) #-}
-(.<-.) :: (MArray array e m) => array Int e -> Int -> e -> m ()
-(.<-.)  = unsafeWrite
+(.<-.) :: (PrimMonad m, Storable a) => M.STVector (PrimState m) a -> Int -> a -> m ()
+(.<-.) = M.unsafeWrite
 
 -- | Macroblock that can be transformed.
-type MutableMacroBlock s a = STUArray s Int a
+type MutableMacroBlock s a = M.STVector s a
 
 {-# INLINE createEmptyMutableMacroBlock #-}
 -- | Create a new macroblock with the good array size
 createEmptyMutableMacroBlock :: ST s (MutableMacroBlock s Int16)
-createEmptyMutableMacroBlock = newArray (0, 63) 0
+createEmptyMutableMacroBlock = M.replicate 64 0
 
 -- row (horizontal) IDCT
 --
@@ -168,11 +176,11 @@ --
 idctCol :: MutableMacroBlock s Int16 -> Int -> ST s ()
 idctCol blk idx = do
-  xx0 <- blk .!!!. (8 * 0 + idx)
+  xx0 <- blk .!!!. (    0 + idx)
   xx1 <- blk .!!!. (8 * 4 + idx)
   xx2 <- blk .!!!. (8 * 6 + idx)
   xx3 <- blk .!!!. (8 * 2 + idx)
-  xx4 <- blk .!!!. (8 * 1 + idx)
+  xx4 <- blk .!!!. (8     + idx)
   xx5 <- blk .!!!. (8 * 7 + idx)
   xx6 <- blk .!!!. (8 * 5 + idx)
   xx7 <- blk .!!!. (8 * 3 + idx)
@@ -217,7 +225,7 @@ 
       f = thirdStage . secondStage $ firstStage initialState
   (blk .<-. (idx + 8*0)) $ iclip !!! ((x7 f + x1 f) .>>. 14)
-  (blk .<-. (idx + 8*1)) $ iclip !!! ((x3 f + x2 f) .>>. 14)
+  (blk .<-. (idx + 8  )) $ iclip !!! ((x3 f + x2 f) .>>. 14)
   (blk .<-. (idx + 8*2)) $ iclip !!! ((x0 f + x4 f) .>>. 14)
   (blk .<-. (idx + 8*3)) $ iclip !!! ((x8 f + x6 f) .>>. 14)
   (blk .<-. (idx + 8*4)) $ iclip !!! ((x8 f - x6 f) .>>. 14)

@@ -1,7 +1,5 @@ {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE TypeSynonymInstances #-}
-{-# LANGUAGE BangPatterns #-}
 -- | 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
@@ -21,24 +19,22 @@ 
                         ) where
 
-import Control.Monad( foldM_, forM_, when )
-import Control.Monad.ST( ST )
+import Control.Monad( foldM_, forM_, when, liftM )
+import Control.Monad.ST( ST, runST )
 import Control.Monad.Trans( lift )
+import Control.Monad.Primitive ( PrimState, PrimMonad )
 import qualified Control.Monad.Trans.State.Strict as S
 import Data.Serialize( Serialize, runGet, get)
 
-import Data.Array.Base( unsafeAt, unsafeRead, unsafeWrite )
--- import Data.Array.Unboxed( (!) )
--- import Data.Array.ST( readArray, writeArray )
-
-import Data.Array.Unboxed( IArray, UArray, listArray, bounds, elems )
-import Data.Array.ST( STUArray, runSTUArray, MArray, newArray, getBounds )
+import qualified Data.Vector.Storable as V
+import qualified Data.Vector.Storable.Mutable as M
 import Data.Bits( (.&.), (.|.), shiftL, shiftR )
 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.Lazy as Lb
+import Foreign.Storable ( Storable )
 
 import Codec.Picture.Types
 import Codec.Picture.Png.Type
@@ -84,17 +80,21 @@                     Nothing -> return 0
 
 {-# INLINE (!!!) #-}
-(!!!) :: (IArray array e) => array Int e -> Int -> e
-(!!!) = unsafeAt
+(!!!) :: (Storable e) => V.Vector e -> Int -> e
+(!!!) = V.unsafeIndex
 
 {-# INLINE (.!!!.) #-}
-(.!!!.) :: (MArray array e m) => array Int e -> Int -> m e
-(.!!!.) = unsafeRead
+(.!!!.) :: (PrimMonad m, Storable a) => M.STVector (PrimState m) a -> Int -> m a
+(.!!!.) = M.unsafeRead
 
 {-# INLINE (.<-.) #-}
-(.<-.) :: (MArray array e m) => array Int e -> Int -> e -> m ()
-(.<-.) = unsafeWrite
+(.<-.) :: (PrimMonad m, Storable a) => M.STVector (PrimState m) a -> Int -> a -> m ()
+(.<-.) = M.unsafeWrite
 
+{-# INLINE getBounds #-}
+getBounds :: (Monad m, Storable a) => M.STVector s a -> m (Int, Int)
+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.
@@ -102,8 +102,8 @@              -> ByteReader s ()
 pngFiltering _ _ (imgWidth, imgHeight) | imgWidth <= 0 || imgHeight <= 0 = return ()
 pngFiltering unpacker beginZeroes (imgWidth, imgHeight) = do
-    thisLine <- lift $ newArray (0, beginZeroes + imgWidth - 1) 0
-    otherLine <- lift $ newArray (0, beginZeroes + imgWidth - 1) 0
+    thisLine <- lift $ M.replicate (beginZeroes + imgWidth) 0
+    otherLine <- lift $ M.replicate (beginZeroes + imgWidth) 0
     foldM_ (\(previousLine, currentLine) lineIndex -> do
                byte <- getNextByte
                let lineFilter = case unparsePngFilter byte of
@@ -183,7 +183,7 @@           pb = abs $ p - b'
           pc = abs $ p - c'
 
-type PngLine s = STUArray s Int Word8
+type PngLine s = M.STVector s Word8
 type LineUnpacker s = Int -> (Int, PngLine s) -> ST s ()
 
 type StrideInfo  = (Int, Int)
@@ -205,11 +205,11 @@                 destSampleIndex = destPixelIndex * sampleCount
                 srcPixelIndex = pixelIndex * sampleCount + beginIdx
                 perPixel sample | sample >= sampleCount = return ()
-                                | otherwise = (do
+                                | otherwise = do
                     val <- line .!!!. (srcPixelIndex + sample)
                     let writeIdx = destSampleIndex + sample
                     (arr .<-. writeIdx) val
-                    perPixel (sample + 1))
+                    perPixel (sample + 1)
             perPixel 0
             inner (pixelIndex + 1)
     inner 0
@@ -235,7 +235,7 @@          (do val <- line .!!!. endLine
              let writeIdx n = lineIndex + (pixelToRead * 8 + n) * strideWidth + beginLeft
              forM_ [0 .. lineRest - 1] $ \bit ->
-                (arr .<-. writeIdx bit) $ ((val `shiftR` (7 - bit)) .&. 0x1))
+                (arr .<-. writeIdx bit) ((val `shiftR` (7 - bit)) .&. 0x1))
 
 
 -- | Unpack lines when bit depth is 2
@@ -262,7 +262,7 @@          (do val <- line .!!!. endLine
              let writeIdx n = lineIndex + (pixelToRead * 4 + n) * strideWidth + beginLeft
              forM_ [0 .. lineRest - 1] $ \bit ->
-                (arr .<-. writeIdx bit) $ ((val `shiftR` (6 - 2 * bit)) .&. 0x3))
+                (arr .<-. writeIdx bit) ((val `shiftR` (6 - 2 * bit)) .&. 0x3))
 
 halfByteUnpacker :: Int -> MutableImage s Word8 -> StrideInfo -> BeginOffset -> LineUnpacker s
 halfByteUnpacker _ (MutableImage{ mutableImageWidth = imgWidth, mutableImageData = arr })
@@ -353,7 +353,7 @@ 
 -- | deinterlace picture in function of the method indicated
 -- in the iHDR
-deinterlacer :: PngIHdr -> ByteReader s (STUArray s Int Word8)
+deinterlacer :: PngIHdr -> ByteReader s (M.STVector s Word8)
 deinterlacer (PngIHdr { width = w, height = h, colourType  = imgKind
                       , interlaceMethod = method, bitDepth = depth  }) = do
     let compCount = sampleCountOfImageType imgKind 
@@ -362,7 +362,7 @@             PngNoInterlace -> scanLineInterleaving
             PngInterlaceAdam7 -> adam7Unpack
         iBitDepth = fromIntegral depth
-    imgArray <- lift $ newArray (0, arraySize - 1) 0
+    imgArray <- lift $ M.replicate arraySize 0
     let mutableImage = MutableImage (fromIntegral w) (fromIntegral h) imgArray
     deinterlaceFunction iBitDepth 
                         (fromIntegral compCount)
@@ -372,7 +372,7 @@     return imgArray
 
 generateGreyscalePalette :: Word8 -> PngPalette
-generateGreyscalePalette times = listArray (0, fromIntegral possibilities) pixels
+generateGreyscalePalette times = V.fromListN (fromIntegral possibilities + 1) pixels
     where possibilities = 2 ^ times - 1
           pixels = [PixelRGB8 i i i | n <- [0..possibilities]
                                     , let i = n * (255 `div` possibilities)]
@@ -389,15 +389,19 @@ paletteRGBA2 = generateGreyscalePalette 2
 paletteRGBA4 = generateGreyscalePalette 4
 
-applyPalette :: PngPalette -> UArray Int Word8 -> UArray Int Word8
-applyPalette pal img = listArray (0, (initSize + 1) * 3 - 1) pixels
+{-# 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 <- elems img
+          pixels = concat [[r, g, b] | ipx <- V.toList img
                                      , let PixelRGB8 r g b = pal !!! fromIntegral ipx]
 
 -- | Helper function trying to load a png file from a file on disk.
 readPng :: FilePath -> IO (Either String DynamicImage)
-readPng path = B.readFile path >>= return . decodePng
+readPng path = liftM decodePng (B.readFile path)
 
 -- | Transform a raw png image to an image, without modifying the
 -- underlying pixel type. If the image is greyscale and < 8 bits,
@@ -432,22 +436,22 @@             | bitDepth ihdr == 1 = unparse (Just paletteRGBA1) PngIndexedColor bytes
             | bitDepth ihdr == 2 = unparse (Just paletteRGBA2) PngIndexedColor bytes
             | bitDepth ihdr == 4 = unparse (Just paletteRGBA4) PngIndexedColor bytes
-            | otherwise = Right . ImageY8 . imager $ runSTUArray stArray
-                where stArray = S.evalStateT (deinterlacer ihdr) bytes
+            | otherwise = Right . ImageY8 . imager $ runST stArray
+                where stArray = S.evalStateT (deinterlacer ihdr) bytes >>= V.unsafeFreeze
         unparse Nothing PngIndexedColor  _ = Left "no valid palette found"
         unparse _ PngTrueColour          bytes =
-            Right . ImageRGB8 . imager $ runSTUArray stArray
-                where stArray = S.evalStateT (deinterlacer ihdr) bytes
+            Right . ImageRGB8 . imager $ runST stArray
+                where stArray = S.evalStateT (deinterlacer ihdr) bytes >>= V.unsafeFreeze
         unparse _ PngGreyscaleWithAlpha  bytes =
-            Right . ImageYA8 . imager $ runSTUArray stArray
-                where stArray = S.evalStateT (deinterlacer ihdr) bytes
+            Right . ImageYA8 . imager $ runST stArray
+                where stArray = S.evalStateT (deinterlacer ihdr) bytes >>= V.unsafeFreeze
         unparse _ PngTrueColourWithAlpha bytes =
-            Right . ImageRGBA8 . imager $ runSTUArray stArray
-                where stArray = S.evalStateT (deinterlacer ihdr) bytes
+            Right . ImageRGBA8 . imager $ runST stArray
+                where stArray = S.evalStateT (deinterlacer ihdr) bytes >>= V.unsafeFreeze
         unparse (Just plte) PngIndexedColor bytes =
             Right . ImageRGB8 . imager $ applyPalette plte uarray
-                where stArray = S.evalStateT (deinterlacer ihdr) bytes
-                      uarray = runSTUArray stArray
+                where stArray = S.evalStateT (deinterlacer ihdr) bytes >>= V.unsafeFreeze
+                      uarray = runST stArray
 
     if B.length compressedImageData <= zlibHeaderSize
        then Left "Invalid data size"

@@ -9,7 +9,7 @@                                ) where
 
 import Data.Serialize(encode)
-import Data.Array.Unboxed((!))
+import Data.Vector.Storable ( (!) )
 import Data.Word(Word8)
 import qualified Codec.Compression.Zlib as Z
 import qualified Data.ByteString as B

@@ -24,7 +24,8 @@                      , putWord8, getWord8
                      , putWord32be, getWord32be
                      , getByteString, putByteString )
-import Data.Array.Unboxed( Array, UArray, listArray, (!) )
+import Data.Array.Unboxed( UArray, listArray, (!) )
+import qualified Data.Vector.Storable as V
 import Data.List( foldl' )
 import Data.Word( Word32, Word8 )
 import qualified Data.ByteString as B
@@ -67,13 +68,13 @@     }
 
 -- | Palette with indices beginning at 0 to elemcount - 1
-type PngPalette = Array Int PixelRGB8
+type PngPalette = V.Vector 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 = listArray (0, pixelCount - 1) <$> runGet pixelUnpacker (chunkData plte)
+ | otherwise = V.fromListN pixelCount <$> runGet pixelUnpacker (chunkData plte)
     where pixelUnpacker = replicateM (fromIntegral pixelCount) get
           pixelCount = fromIntegral $ chunkLength plte `div` 3
 

@@ -26,11 +26,14 @@                           ) where
 
 import Control.Applicative( (<$>), (<*>) )
-import Control.Monad.ST( ST )
+import Control.Monad.ST( ST, runST )
+import Control.Monad.Primitive ( PrimMonad, PrimState )
+import Foreign.Storable ( Storable, sizeOf, alignment, peek, poke )
+import Foreign.Ptr ( plusPtr )
 import Data.Word( Word8 )
-import Data.Array.Unboxed( UArray, (!) )
-import Data.Array.ST( MArray, STUArray
-                    , writeArray, newArray, runSTUArray, readArray )
+import Data.Vector.Storable ( (!) )
+import qualified Data.Vector.Storable as V
+import qualified Data.Vector.Storable.Mutable as M
 import Data.Serialize( Serialize, put, get )
 
 
@@ -45,7 +48,7 @@ 
       -- | The real image, to extract pixels at some position
       -- you should use the helpers functions.
-    , imageData   :: UArray Int Word8
+    , imageData   :: V.Vector Word8
     }
 
 -- | Image or pixel buffer, the coordinates are assumed to start
@@ -60,7 +63,7 @@ 
       -- | The real image, to extract pixels at some position
       -- you should use the helpers functions.
-    , mutableImageData   :: STUArray s Int Word8
+    , mutableImageData   :: M.STVector s Word8
     }
 
 -- | Type allowing the loading of an image with different pixel
@@ -105,7 +108,7 @@                            {-# UNPACK #-} !Word8 -- Blue
 
 -- | Pixel storing data in the YCbCr colorspace,
--- value are stored in teh following order :
+-- value are stored in the following order :
 --
 --  * Y (luminance)
 --
@@ -138,24 +141,124 @@     {-# INLINE get #-}
     get = PixelYA8 <$> get <*> get
 
+instance Storable PixelYA8 where
+    {-# INLINE sizeOf #-}
+    sizeOf _ = sizeOf (undefined :: Word8) * 2
+    {-# INLINE alignment #-}
+    alignment _ = alignment (undefined :: Word8)
+    {-# INLINE peek #-}
+    peek ptr = do
+      let __   = undefined :: Word8
+          yOff = sizeOf __ * 0
+          aOff = sizeOf __ * 1
+      y <- peek $ ptr `plusPtr` yOff
+      a <- peek $ ptr `plusPtr` aOff
+      return (PixelYA8 y a)
+    {-# INLINE poke #-}
+    poke ptr (PixelYA8 y a) = do
+      let __   = undefined :: Word8
+          yOff = sizeOf __ * 0
+          aOff = sizeOf __ * 1
+      poke (ptr `plusPtr` yOff) y
+      poke (ptr `plusPtr` aOff) a
+
 instance Serialize PixelRGB8 where
     {-# INLINE put #-}
     put (PixelRGB8 r g b) = put r >> put g >> put b
     {-# INLINE get #-}
     get = PixelRGB8 <$> get <*> get <*> get
 
+instance Storable PixelRGB8 where
+    {-# INLINE sizeOf #-}
+    sizeOf _ = sizeOf (undefined :: Word8) * 3
+    {-# INLINE alignment #-}
+    alignment _ = alignment (undefined :: Word8)
+    {-# INLINE peek #-}
+    peek ptr = do
+      let __   = undefined :: Word8
+          rOff = sizeOf __ * 0
+          gOff = sizeOf __ * 1
+          bOff = sizeOf __ * 2
+      r <- peek $ ptr `plusPtr` rOff
+      g <- peek $ ptr `plusPtr` gOff
+      b <- peek $ ptr `plusPtr` bOff
+      return (PixelRGB8 r g b)
+    {-# INLINE poke #-}
+    poke ptr (PixelRGB8 r g b) = do
+      let __   = undefined :: Word8
+          rOff = sizeOf __ * 0
+          gOff = sizeOf __ * 1
+          bOff = sizeOf __ * 2
+      poke (ptr `plusPtr` rOff) r
+      poke (ptr `plusPtr` gOff) g
+      poke (ptr `plusPtr` bOff) b
+
 instance Serialize PixelYCbCr8 where
     {-# INLINE put #-}
     put (PixelYCbCr8 y cb cr) = put y >> put cb >> put cr
     {-# INLINE get #-}
     get = PixelYCbCr8 <$> get <*> get <*> get
 
+instance Storable PixelYCbCr8 where
+    {-# INLINE sizeOf #-}
+    sizeOf _ = sizeOf (undefined :: Word8) * 3
+    {-# INLINE alignment #-}
+    alignment _ = alignment (undefined :: Word8)
+    {-# INLINE peek #-}
+    peek ptr = do
+      let __   = undefined :: Word8
+          yOff = sizeOf __ * 0
+          cbOff = sizeOf __ * 1
+          crOff = sizeOf __ * 2
+      y  <- peek $ ptr `plusPtr` yOff
+      cb <- peek $ ptr `plusPtr` cbOff
+      cr <- peek $ ptr `plusPtr` crOff
+      return (PixelYCbCr8 y cb cr)
+    {-# INLINE poke #-}
+    poke ptr (PixelYCbCr8 y cb cr) = do
+      let __   = undefined :: Word8
+          yOff  = sizeOf __ * 0
+          cbOff = sizeOf __ * 1
+          crOff = sizeOf __ * 2
+      poke (ptr `plusPtr`  yOff) y
+      poke (ptr `plusPtr` cbOff) cb
+      poke (ptr `plusPtr` crOff) cr
+
 instance Serialize PixelRGBA8 where
     {-# INLINE put #-}
     put (PixelRGBA8 r g b a) = put r >> put g >> put b >> put a
     {-# INLINE get #-}
     get = PixelRGBA8 <$> get <*> get <*> get <*> get
 
+instance Storable PixelRGBA8 where
+    {-# INLINE sizeOf #-}
+    sizeOf _ = sizeOf (undefined :: Word8) * 4
+    {-# INLINE alignment #-}
+    alignment _ = alignment (undefined :: Word8)
+    {-# INLINE peek #-}
+    peek ptr = do
+      let __   = undefined :: Word8
+          rOff = sizeOf __ * 0
+          gOff = sizeOf __ * 1
+          bOff = sizeOf __ * 2
+          aOff = sizeOf __ * 3
+      r <- peek $ ptr `plusPtr` rOff
+      g <- peek $ ptr `plusPtr` gOff
+      b <- peek $ ptr `plusPtr` bOff
+      a <- peek $ ptr `plusPtr` aOff
+      return (PixelRGBA8 r g b a)
+    {-# INLINE poke #-}
+    poke ptr (PixelRGBA8 r g b a) = do
+      let __   = undefined :: Word8
+          rOff = sizeOf __ * 0
+          gOff = sizeOf __ * 1
+          bOff = sizeOf __ * 2
+          aOff = sizeOf __ * 3
+      poke (ptr `plusPtr` rOff) r
+      poke (ptr `plusPtr` gOff) g
+      poke (ptr `plusPtr` bOff) b
+      poke (ptr `plusPtr` aOff) a
+
 -- | Describe pixel kind at runtime
 data PixelType = PixelMonochromatic         -- ^ For 2 bits pixels
                | PixelGreyscale
@@ -220,14 +323,17 @@     promoteImage :: Image a -> Image b
     promoteImage image@(Image { imageWidth = w, imageHeight = h }) =
         Image w h pixels
-         where pixels = runSTUArray $ do
-                    newArr <- newArray (0, w * h * componentCount (undefined :: b) - 1) 0
+         where pixels = runST $ do
+                    newArr <- M.replicate (w * h * componentCount (undefined :: b)) 0
                     let wrapped = MutableImage w h newArr
                         promotedPixel :: Int -> Int -> b
-                        promotedPixel x y = promotePixel $ pixelAt image x y 
+                        promotedPixel x y = promotePixel $ pixelAt image x y
                     sequence_ [writePixel wrapped x y $ promotedPixel x y
                                         | y <- [0 .. h - 1], x <- [0 .. w - 1] ]
-                    return newArr
+                    -- 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
 
 -- | This class abstract colorspace conversion. This
 -- conversion can be lossy, which ColorConvertible cannot
@@ -237,14 +343,17 @@     convertImage :: Image a -> Image b
     convertImage image@(Image { imageWidth = w, imageHeight = h }) =
         Image w h pixels
-         where pixels = runSTUArray $ do
-                    newArr <- newArray (0, w * h * componentCount (undefined :: b) - 1) 0
+         where pixels = runST $ do
+                    newArr <- M.replicate (w * h * componentCount (undefined :: b)) 0
                     let wrapped = MutableImage w h newArr
                         promotedPixel :: Int -> Int -> b
-                        promotedPixel x y = convertPixel $ pixelAt image x y 
+                        promotedPixel x y = convertPixel $ pixelAt image x y
                     sequence_ [writePixel wrapped x y $ promotedPixel x y
                                         | y <- [0 .. h - 1], x <- [0 .. w - 1] ]
-                    return newArr
+                    -- 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
 
 -- | Free promotion for identic pixel types
 instance (Pixel a) => ColorConvertible a a where
@@ -255,12 +364,12 @@     promoteImage = id
 
 {-# INLINE (.!!!.) #-}
-(.!!!.) :: (MArray array e m) => array Int e -> Int -> m e
-(.!!!.) = readArray -- unsafeRead
+(.!!!.) :: (PrimMonad m, Storable a) => M.STVector (PrimState m) a -> Int -> m a
+(.!!!.) = M.read -- unsafeRead
 
 {-# INLINE (.<-.) #-}
-(.<-.) :: (MArray array e m) => array Int e -> Int -> e -> m ()
-(.<-.)  = writeArray -- unsafeWrite
+(.<-.) :: (PrimMonad m, Storable a) => M.STVector (PrimState m) a -> Int -> a -> m ()
+(.<-.)  = M.write -- unsafeWrite
 
 --------------------------------------------------
 ----            Pixel8 instances
@@ -272,10 +381,10 @@     pixelAt (Image { imageWidth = w, imageData = arr }) x y = arr ! (x + y * w)
 
     readPixel image@(MutableImage { mutableImageData = arr }) x y =
-        arr .!!!. (mutablePixelBaseIndex image x y)
+        arr .!!!. mutablePixelBaseIndex image x y
     
-    writePixel image@(MutableImage { mutableImageData = arr }) x y v =
-        (arr .<-. (mutablePixelBaseIndex image x y)) v
+    writePixel image@(MutableImage { mutableImageData = arr }) x y =
+        arr .<-. mutablePixelBaseIndex image x y
 
 instance ColorConvertible Pixel8 PixelYA8 where
     {-# INLINE promotePixel #-}

@@ -1,5 +1,5 @@ Name:                JuicyPixels
-Version:             1.0
+Version:             1.1
 Synopsis:            Picture loading/serialization (in png, jpeg and bitmap)
 Description:
     This library can load and store images in various image formats,
@@ -25,7 +25,7 @@ Source-Repository this
     Type:      git
     Location:  git://github.com/Twinside/Juicy.Pixels.git
-    Tag:       v1.0
+    Tag:       v1.1
 
 Library
   Exposed-modules:  Codec.Picture,
@@ -41,7 +41,9 @@                  mtl >= 1.1,
                  cereal >= 0.3.3.0 && < 0.4,
                  zlib >= 0.5.3.1,
-                 transformers >= 0.2.2 && < 0.3
+                 transformers >= 0.2.2 && < 0.3,
+                 vector >= 0.9 && < 1.0,
+                 primitive >= 0.4 && < 0.5
 
 -- Modules not exported by this package.
   Other-modules: Codec.Picture.Jpg.DefaultTable,