diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,21 @@
+1.4.0.0
+=======
+
+Major rewrite, with most of functionality is still backwards compatible, but
+with a some extra features.
+
+* Storable Repa and Vector representations through generic implementations
+* `ColorSpace` is more general allowing for non polymorphic Pixel types
+* `Elevator` works on base types rather than on pixels
+* Conversions from JuicyPixels and NetPbm is done through casting a Vector
+  rather than through an explicit conversion.
+
+Major API changes:
+
+  * Renaming `RS` and `RP` Repa representations into `RSU` and `RPU`.
+  * Addition `VS` Storable Vector representationas well as `RSS` and `RPS`
+    Storable Repa representations.
+    
 1.3.0.0
 =======
 
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -19,7 +19,7 @@
 
 * `$ stack install hip`
 
-In order to be able to view images in GHCi and external image viewer is used. On
-Linux I recommend `GPicView`, but you can use any viewer that accepts a filename
-as an argument, so by default OS specific image viewer is used.
+In order to be able to view images in GHCi an external image viewer is used. You
+can use any viewer that accepts a filename as an argument, and by default, image
+viewer specified by the OS is used.
 
diff --git a/benchmarks/Canny.hs b/benchmarks/Canny.hs
new file mode 100644
--- /dev/null
+++ b/benchmarks/Canny.hs
@@ -0,0 +1,161 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE BangPatterns #-}
+module Main where
+
+import Prelude as P
+import Criterion.Main
+import Graphics.Image as I
+import Graphics.Image.Interface as I
+import Graphics.Image.Interface.Repa
+
+
+import Data.Array.Repa as R
+import Data.Array.Repa.Eval
+import Data.Array.Repa.Repr.Unboxed
+import Data.Array.Repa.Stencil
+import Data.Array.Repa.Stencil.Dim2
+
+
+sobelGx :: I.Array arr cs e => Image arr cs e -> Image arr cs e
+sobelGx =
+  convolve Edge (fromLists [[-1, 0, 1], [-2, 0, 2], [-1, 0, 1]])
+
+sobelGy :: I.Array arr cs e => Image arr cs e -> Image arr cs e
+sobelGy =
+  convolve Edge (fromLists [[-1,-2,-1], [ 0, 0, 0], [ 1, 2, 1]])
+
+-- sobelSGx :: (Exchangable arr VS, I.Array arr cs e, I.Array VS cs e) => Image arr cs e -> Image arr cs e
+-- sobelSGx =
+--   convolveSparse Edge (fromLists [[-1, 0, 1], [-2, 0, 2], [-1, 0, 1]])
+
+-- sobelSGy :: (Exchangable arr VS, I.Array arr cs e, I.Array VS cs e) => Image arr cs e -> Image arr cs e
+-- sobelSGy =
+--   convolveSparse Edge (fromLists [[-1,-2,-1], [ 0, 0, 0], [ 1, 2, 1]])
+
+
+-- sobelSGx' :: (Exchangable arr VS, I.Array arr cs e, I.Array VS cs e) => Image arr cs e -> Image arr cs e
+-- sobelSGx' =
+--   convolveSparse Edge (fromLists [[1], [2], [1]]) . convolveSparse Edge (fromLists [[1, 0, -1]])
+
+sobelGx' :: I.Array arr cs e => Image arr cs e -> Image arr cs e
+sobelGx' =
+  convolveCols Edge [1, 2, 1] . convolveRows Edge [1, 0, -1]
+
+sobelGy' :: I.Array arr cs e => Image arr cs e -> Image arr cs e
+sobelGy' =
+  convolveCols Edge [1, 0, -1] . convolveRows Edge [1, 2, 1]
+
+
+sobelGxR
+  :: (Source r e, Num e) => R.Array r DIM2 e
+     -> R.Array PC5 DIM2 e
+sobelGxR = mapStencil2 BoundClamp stencil 
+  where stencil = makeStencil2 3 3
+                  (\ix -> case ix of
+                      Z :. -1 :. -1  -> Just (-1)
+                      Z :.  0 :. -1  -> Just (-2)
+                      Z :.  1 :. -1  -> Just (-1)
+                      Z :. -1 :.  1  -> Just 1
+                      Z :.  0 :.  1  -> Just 2
+                      Z :.  1 :.  1  -> Just 1
+                      _              -> Nothing)
+
+sobelGyR
+  :: (Source r e, Num e) => R.Array r DIM2 e
+     -> R.Array PC5 DIM2 e
+sobelGyR = mapStencil2 BoundClamp stencil 
+  where stencil = makeStencil2 3 3
+                  (\ix -> case ix of
+                      Z :.  1 :. -1  -> Just (-1)
+                      Z :.  1 :.  0  -> Just (-2)
+                      Z :.  1 :.  1  -> Just (-1)
+                      Z :. -1 :. -1  -> Just 1
+                      Z :. -1 :.  0  -> Just 2
+                      Z :. -1 :.  1  -> Just 1
+                      _              -> Nothing)
+
+force
+  :: (Load r1 sh e, Unbox e, Monad m)
+  => R.Array r1 sh e -> m (R.Array U sh e)
+force arr = do
+    forcedArr <- computeUnboxedP arr
+    forcedArr `deepSeqArray` return forcedArr
+
+
+
+main :: IO ()
+main = do
+  img' <- readImageRGB RPU "images/downloaded/frog-1280x824.jpg"
+  let !imgU = compute img'
+  --let !imgS = exchange RPS imgU
+  let sobelU = sobelGx imgU
+  let sobelSepU = sobelGx' imgU
+  -- let sobelS = sobelGx imgS
+  -- let sobelSepS = sobelGx' imgS
+  -- let sobelSepVS = sobelSGx' img
+  -- let sobelVS = sobelSGx img
+  -- let sobelMS = sobelMSGx img
+  -- let sobelIMS = sobelIMSGx img
+  -- let sobelHMS = sobelHMSGx img
+  let !imgR = toRepaArray imgU
+  --imgRDouble <- force $ R.map (`getPxCh` Y) imgR
+  let sobelR = sobelGxR imgR
+  --let sobelRDouble = sobelGxR imgRDouble
+  defaultMain
+    [ bgroup
+        "Sobel"
+        [ bench "naive U" $ whnf compute sobelU
+        , bench "separated U" $ whnf compute sobelSepU
+        -- , bench "naive S" $ whnf compute sobelS
+        -- , bench "separated S" $ whnf compute sobelSepS
+        -- , bench "separated VS" $ whnf compute sobelSepVS
+        -- , bench "sparse VS" $ whnf compute sobelVS
+        -- , bench "sparse MS" $ whnf compute sobelMS
+        -- , bench "sparse IMS" $ whnf compute sobelIMS
+        -- , bench "sparse HMS" $ whnf compute sobelHMS
+        --, bench "repa" $ whnf (compute . fromRepaArrayP) sobelR
+        , bench "repa RGB" $ whnfIO (force sobelR)
+        --, bench "repa Double" $ whnfIO (force sobelRDouble)
+        ]
+    ]
+  -- img' <- readImageY RS "images/downloaded/frog-1280x824.jpg"
+  -- let !imgR = compute img'
+  -- let !imgV = toManifest imgR
+  -- -- let sobel = sobelGx imgV
+  -- -- let sobel' = sobelGx' imgV
+  -- -- let sobel'' = sobelSGx imgV
+  -- let arrR = toRepaArray imgR
+  -- let sobelR = sobelGxR arrR
+  -- defaultMain
+  --   [ bgroup
+  --       "Sobel"
+  --       [ bench "naive" $ nf sobelGx imgV
+  --       , bench "separated" $ nf sobelGx' imgV
+  --       , bench "sparse" $ nf sobelSGx imgV
+  --       --, bench "repa" $ whnf (compute . fromRepaArrayP) sobelR
+  --       , bench "repa" $ whnfIO (force sobelR)
+  --       ]
+  --   ]
+
+  -- let sobel = sqrt (sobelGx img ^ (2 :: Int) + sobelGy img ^ (2 :: Int))
+  -- let sobel' = sqrt (sobelGx' img ^ (2 :: Int) + sobelGy' img ^ (2 :: Int))
+  -- let sobel'' = sqrt (sobelSGx img ^ (2 :: Int) + sobelSGy img ^ (2 :: Int))
+  -- let sobel''' = sqrt (sobelMSGx img ^ (2 :: Int) + sobelMSGy img ^ (2 :: Int))
+  -- let imgR = toRepaArray img
+  -- let sobelR =
+  --       R.map
+  --         sqrt
+  --         (R.map (^ (2 :: Int)) (sobelGxR imgR) +^
+  --          R.map (^ (2 :: Int)) (sobelGyR imgR))
+  -- defaultMain
+  --   [ bgroup
+  --       "Sobel"
+  --       [ bench "naive" $ whnf compute sobel
+  --       , bench "separated" $ whnf compute sobel'
+  --       , bench "sparse VS" $ whnf compute sobel''
+  --       , bench "sparse MS" $ whnf compute sobel'''
+  --       --, bench "repa" $ whnf (compute . fromRepaArrayP) sobelR
+  --       , bench "repa" $ whnfIO (force sobelR)
+  --       ]
+  --   ]
+
diff --git a/benchmarks/Interface.hs b/benchmarks/Interface.hs
deleted file mode 100644
--- a/benchmarks/Interface.hs
+++ /dev/null
@@ -1,75 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-module Main where
-
-import Prelude as P
-import Criterion.Main
-import Graphics.Image.Interface as I
---import Graphics.Image.Processing
-
---import qualified Graphics.Image.Interface.Vector as V
-import Graphics.Image.Types
-
-main :: IO ()
-main = do
-  defaultMain
-    [ bgroup
-        "RP fusion"
-        [ bench "native" $
-          whnf
-            (compute  . (noFusion :: (Int, Int) -> Image RP Y Double))
-            (1000, 1000)
-        , bench "RP fusion" $
-          whnf
-            (compute  . (fusion :: (Int, Int) -> Image RP Y Double))
-            (1000, 1000)
-        ]
-    , bgroup
-        "RS fusion"
-        [ bench "native" $
-          whnf
-            (compute . (noFusion :: (Int, Int) -> Image RS Y Double))
-            (1000, 1000)
-        , bench "RS fusion" $
-          whnf
-            (compute . (fusion :: (Int, Int) -> Image RS Y Double))
-            (1000, 1000)
-        ]
-    , bgroup
-        "VU fusion"
-        [ bench "no fusion" $
-          nf (noFusion :: (Int, Int) -> Image VU Y Double) (1000, 1000)
-        , bench "VU fusion" $
-          nf (fusion :: (Int, Int) -> Image VU Y Double) (1000, 1000)
-        ]
-    ]
---frog <- V.readImageY "images/frog.jpg"
---     [ bgroup
---         ("makeImage big " ++ show bigDims)
---         [ bench "makeImage VU" $ nf (`V.makeImage` getPxY) bigDims
---         , bench "computeS" $ nf R.computeS (R.makeImage bigDims getPxY)
---           -- parallel
---         , bench "computeP" $ nf R.computeP (R.makeImage bigDims getPxY)
---         ]
---     , bgroup
---         "Sobel operator"
---         [ bench "sobel VU" $ nf sobel frog
---         , bench "sobel RS" $ nf (sobel . exchange RS) frog
---           -- parallel
---         , bench "sobel RP" $ nf (sobel . R.computeP . exchange RP) frog
---         ]
---     ]
-    where
---     bigDims = (2000, 2000)
-      getPxY :: (Int, Int) -> Pixel Y Double
-      getPxY (i, j) = fromIntegral (i * j)
-      noFusion ds = makeImage ds getPx
-        where getPx :: (Int, Int) -> Pixel Y Double
-              getPx (i, j) = (getPxY (i, j) / 5 - fromIntegral i) * 21
-      fusion ds = imap (\ (i, _) px -> (px - fromIntegral i) * 21) $ (makeImage ds getPxY / 5)
-
-
--- sobel :: ManifestArray arr cs Double => Image arr cs Double -> Image arr cs Double
--- sobel img = sqrt (imgX ^ (2 :: Int) + imgY ^ (2 :: Int))
---   where
---     imgX = convolve Edge (fromLists [[-1, 0, 1], [-2, 0, 2], [-1, 0, 1]]) img
---     imgY = convolve Edge (fromLists [[-1,-2,-1], [ 0, 0, 0], [ 1, 2, 1]]) img
diff --git a/hip.cabal b/hip.cabal
--- a/hip.cabal
+++ b/hip.cabal
@@ -1,5 +1,5 @@
 Name:              hip
-Version:           1.3.0.0
+Version:           1.4.0.0
 License:           BSD3
 License-File:      LICENSE
 Author:            Alexey Kuleshevich
@@ -76,7 +76,12 @@
                  , Graphics.Image.IO.Base
                  , Graphics.Image.IO.Formats.JuicyPixels
                  , Graphics.Image.IO.Formats.Netpbm
-                 , Graphics.Image.Interface.Repa.Internal
+                 , Graphics.Image.Interface.Repa.Generic
+                 , Graphics.Image.Interface.Repa.Storable
+                 , Graphics.Image.Interface.Repa.Unboxed
+                 , Graphics.Image.Interface.Repa.Helpers
+                 , Graphics.Image.Interface.Vector.Generic
+                 , Graphics.Image.Interface.Vector.Storable
                  , Graphics.Image.Interface.Vector.Unboxed
                  , Graphics.Image.Interface.Vector.Unboxing
                  , Graphics.Image.Processing.Convolution
@@ -99,6 +104,7 @@
   Main-Is:            Spec.hs
   Other-Modules:      Graphics.Image.ColorSpaceSpec
                     , Graphics.Image.ProcessingSpec
+                    , Graphics.Image.Processing.BinarySpec
                     , Graphics.Image.InterfaceSpec
                     , Graphics.Image.Interface.VectorSpec
   Build-Depends:      base            >= 4.5 && < 5
@@ -109,16 +115,56 @@
   GHC-Options:        -Wall -threaded -with-rtsopts=-N
 
 
-benchmark interface-benchmarks
+-- benchmark pixels-benchmarks
+--   type:                exitcode-stdio-1.0
+--   hs-source-dirs:      benchmarks
+--   main-is:             Pixels.hs
+--   ghc-options:         -threaded -rtsopts -with-rtsopts=-N -O2
+--   build-depends:       base
+--                      , criterion
+--                      , deepseq
+--                      , hip
+--                      , vector
+--   default-language:    Haskell2010
+
+-- benchmark pixels-memory
+--   type:                exitcode-stdio-1.0
+--   hs-source-dirs:      benchmarks/memory
+--   main-is:             Pixels.hs
+--   ghc-options:         -O2
+--                        -- -threaded -rtsopts -with-rtsopts=-N
+--   build-depends:       base
+--                      , criterion
+--                      , deepseq
+--                      , hip
+--                      , weigh
+--                      , vector
+--                      , repa
+--   default-language:    Haskell2010
+
+-- benchmark interface-benchmarks
+--   type:                exitcode-stdio-1.0
+--   hs-source-dirs:      benchmarks
+--   main-is:             Interface.hs
+--   ghc-options:         -threaded -rtsopts -with-rtsopts=-N -O2
+--   build-depends:       base
+--                      , criterion
+--                      , deepseq
+--                      , hip
+--                      , vector
+--   default-language:    Haskell2010
+
+benchmark convolution-benchmarks
   type:                exitcode-stdio-1.0
   hs-source-dirs:      benchmarks
-  main-is:             Interface.hs
-  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  main-is:             Canny.hs
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N -O2
+  --ghc-options:         -Odph -rtsopts -with-rtsopts=-N -threaded -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000 -fllvm -optlo-O3
   build-depends:       base
                      , criterion
                      , deepseq
+                     , repa
                      , hip
-                     , vector
   default-language:    Haskell2010
 
 Source-Repository head
diff --git a/images/figure_close.png b/images/figure_close.png
Binary files a/images/figure_close.png and b/images/figure_close.png differ
diff --git a/images/figure_dialate.png b/images/figure_dialate.png
Binary files a/images/figure_dialate.png and b/images/figure_dialate.png differ
diff --git a/images/figure_erode.png b/images/figure_erode.png
Binary files a/images/figure_erode.png and b/images/figure_erode.png differ
diff --git a/images/figure_open.png b/images/figure_open.png
Binary files a/images/figure_open.png and b/images/figure_open.png differ
diff --git a/images/struct.png b/images/struct.png
Binary files a/images/struct.png and b/images/struct.png differ
diff --git a/src/Graphics/Image.hs b/src/Graphics/Image.hs
--- a/src/Graphics/Image.hs
+++ b/src/Graphics/Image.hs
@@ -1,6 +1,5 @@
 {-# OPTIONS_GHC -fno-warn-unused-imports #-}
 {-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleContexts #-}
 -- |
 -- Module      : Graphics.Image
@@ -18,11 +17,11 @@
 -- * @__`Array` arr cs e__@ - this is a base class for every
 -- __@`Image`@ @arr@ @cs@ @e@__, where @__arr__@ stands for an underlying array
 -- representation, @__cs__@ is the `ColorSpace` of an image and @__e__@ is the
--- type denoting precision of an image.
+-- type denoting precision of an image (@Int@, @Word@, @Double@, etc.) .
 --
 -- * @__`MArray` arr cs e__@ - is a kind of array, that can be indexed in
--- constant time and allows monadic operations and mutation on __@`MImage`@ @st@
--- @arr@ @cs@ @e@__, which is `Image`'s mutable cousin.
+-- constant time and allows monadic operations and mutation on
+-- __@`MImage`@ @st@ @arr@ @cs@ @e@__, which is `Image`'s mutable cousin.
 --
 -- Array representation type and the above classes it is installed in determine
 -- operations that can be done on the image with that representation.
@@ -30,27 +29,25 @@
 -- Representations using <http://hackage.haskell.org/package/vector Vector> and
 -- <http://hackage.haskell.org/package/repa Repa> packages:
 --
--- * `VU` - Unboxed Vector representation. (Default)
--- * `RS` - Unboxed Repa array representation (computation is done sequentially).
--- * `RP` - Unboxed Repa array representation (computation is done in parallel).
+-- * `VU` - Vector Unboxed representation.
+-- * `VS` - Vector Storable representation.
+-- * `RSU` - Repa Sequential Unboxed array representation (computation is done sequentially).
+-- * `RPU` - Repa Parallel Unboxed array representation (computation is done in parallel).
+-- * `RSS` - Repa Sequential Storable array representation (computation is done sequentially).
+-- * `RPS` - Repa Parallel Storable array representation (computation is done in parallel).
 --
--- Images with `RS` and `RP` types, most of the time hold functions rather then
+-- Images with `RSU` and `RPU` types, most of the time hold functions rather then
 -- actual data, this way computation can be fused together, and later changed to
 -- `VU` using `toManifest`, which in turn performs the fused computation. If at
 -- any time computation needs to be forced, `compute` can be used for that
 -- purpose.
 --
--- Just as it is mentioned above, Vector representation is a default one, so in
--- order to create images with Repa representation
--- "Graphics.Image.Interface.Repa" module should be used.
---
 -- Many of the function names exported by this module will clash with the ones
--- from "Prelude", hence it can be more convenient to import it qualified and
--- all relevenat types import using "Graphics.Image.Types" module:
+-- from "Prelude", hence it can be more convenient to import like this:
 --
 -- @
--- import qualified Graphics.Image as I
--- import Graphics.Image.Types
+-- import Prelude as P
+-- import Graphics.Image as I
 -- @
 --
 module Graphics.Image (
@@ -59,14 +56,17 @@
 
   -- * Creation
   --
-  -- If it is necessary to create an image in an other representation
-  -- or with some specific 'Pixel' precision, you can use 'make' from
-  -- "Graphics.Image.Interface" module and manually specifying function's output
-  -- type, ex:
+  -- `makeImageR` is a type restricted version of `makeImage` function, which
+  -- simplifies creation of images with `Double` precision and a particular
+  -- representation through an extra argument.
   --
-  -- @ makeImage (256, 256) (PixelY . fromIntegral . fst) :: Image RP Y Word8 @
+  -- If it is necessary to create an image with an arbitrary precision and
+  -- representation, `makeImage` function can be used with a manual type
+  -- specification of result image, eg:
   --
-  makeImage, makeImageS, makeImageP, fromLists, fromListsS, fromListsP, toLists,
+  -- @ makeImage (256, 256) (PixelY . fromIntegral . fst) :: Image RPU Y Word8 @
+  --
+  makeImageR, makeImage, fromListsR, fromLists, toLists,
   -- * IO
   -- ** Reading
   -- | Read supported files into an 'Image' with pixels in 'Double'
@@ -74,15 +74,15 @@
   -- space or precision, use 'readImage' or 'readImageExact' from
   -- <Graphics-Image-IO.html Graphics.Image.IO> instead. While reading an
   -- image, it's underlying representation can be specified by passing one of
-  -- `VU`, `RS` or `RP` as the first argument to @readImage*@ functions. Here is
+  -- `VU`, `RSU` or `RPU` as the first argument to @readImage*@ functions. Here is
   -- a quick demonstration of how two images can be read as different
   -- representations and later easily combined as their average.
   --
-  -- >>> cluster <- readImageRGB RP "images/cluster.jpg"
+  -- >>> cluster <- readImageRGB RPU "images/cluster.jpg"
   -- >>> displayImage cluster
   -- >>> centaurus <- readImageRGB VU "images/centaurus.jpg"
   -- >>> displayImage centaurus
-  -- >>> displayImage ((cluster + exchange RP centaurus) / 2)
+  -- >>> displayImage ((cluster + exchange RPU centaurus) / 2)
   --
   -- <<images/cluster.jpg>> <<images/centaurus.jpg>> <<images/centaurus_and_cluster.jpg>>
   --
@@ -96,38 +96,60 @@
   index, maybeIndex, defaultIndex, borderIndex,
   -- * Transformation
   -- ** Pointwise
-  map, imap, zipWith, izipWith,
+  I.map, imap, I.zipWith, izipWith,
   -- ** Geometric
-  traverse, traverse2,
+  I.traverse, traverse2,
   transpose, backpermute,
   (|*|), 
   -- * Reduction
   fold, sum, product, maximum, minimum, normalize,
   -- * Representations
   exchange,
-  VU(..), RS(..), RP(..),
+  module IP
   ) where
 
-#if MIN_VERSION_base(4,8,0)
-import Prelude hiding (map, zipWith, sum, product, maximum, minimum, traverse)
-#else
-import Prelude hiding (map, zipWith, sum, product, maximum, minimum)
-import Control.Applicative (pure)
-#endif
+import Prelude as P hiding (maximum, minimum, sum, product)
 import qualified Data.Foldable as F
 import Graphics.Image.ColorSpace
 import Graphics.Image.IO
-import Graphics.Image.Interface as I hiding (makeImage, fromLists)
-import Graphics.Image.Interface.Vector
-import Graphics.Image.Interface.Repa
+import Graphics.Image.Interface as I
+import Graphics.Image.Types as IP
 
+import Graphics.Image.Processing as IP
+import Graphics.Image.Processing.Binary as IP
+import Graphics.Image.Processing.Complex as IP
+import Graphics.Image.Processing.Geometric as IP
+import Graphics.Image.IO.Histogram as IP
 
-import Graphics.Image.Processing
-import Graphics.Image.Processing.Binary
-import Graphics.Image.Processing.Complex
-import Graphics.Image.Processing.Geometric
-import Graphics.Image.IO.Histogram
 
+-- | Create an image with a specified representation and pixels of 'Double'
+-- precision. Note, that it is essential for 'Double' precision pixels to keep values
+-- normalized in the @[0, 1]@ range in order for an image to be written to file
+-- properly.
+--
+-- >>> let grad_gray = makeImageR VU (200, 200) (\(i, j) -> PixelY (fromIntegral i) / 200 * (fromIntegral j) / 200)
+--
+-- Because all 'Pixel's and 'Image's are installed into 'Num', above is equivalent to:
+--
+-- >>> let grad_gray = makeImageR RPU (200, 200) (\(i, j) -> PixelY $ fromIntegral (i*j)) / (200*200)
+-- >>> writeImage "images/grad_gray.png" grad_gray
+--
+-- Creating color images is just as easy.
+--
+-- >>> let grad_color = makeImageR VU (200, 200) (\(i, j) -> PixelRGB (fromIntegral i) (fromIntegral j) (fromIntegral (i + j))) / 400
+-- >>> writeImage "images/grad_color.png" grad_color
+--
+-- <<images/grad_gray.png>> <<images/grad_color.png>>
+--
+makeImageR :: Array arr cs Double =>
+              arr -- ^ Underlying image representation.
+           -> (Int, Int) -- ^ (@m@ rows, @n@ columns) - dimensions of a new image.
+           -> ((Int, Int) -> Pixel cs Double)
+           -- ^ A function that takes (@i@-th row, and @j@-th column) as an argument
+           -- and returns a pixel for that location.
+           -> Image arr cs Double
+makeImageR _ = I.makeImage
+{-# INLINE makeImageR #-}
 
 -- | Read image as luma (brightness).
 readImageY :: Array arr Y Double => arr -> FilePath -> IO (Image arr Y Double)
@@ -204,18 +226,24 @@
 
 
 -- | Scales all of the pixels to be in the range @[0, 1]@.
-normalize :: (Array arr cs e, Array arr Gray e, Fractional e, Ord e) =>
+normalize :: (Array arr cs e, Array arr Gray e, Fractional e,
+              Fractional (Pixel cs e), Ord e) =>
              Image arr cs e -> Image arr cs e
 normalize !img = if l == s
                  then (if s < 0 then (*0) else if s > 1 then (*1) else id) img
-                 else map normalizer img
+                 else I.map normalizer img
   where
-    !(PixelGray l, PixelGray s) = (maximum $ map (PixelGray . F.maximum) img,
-                                   minimum $ map (PixelGray . F.minimum) img)
-    normalizer !px = (px - pure s) / pure (l - s)
+    !(PixelGray l, PixelGray s) = (maximum (I.map (PixelGray . foldl1Px max) img),
+                                   minimum (I.map (PixelGray . foldl1Px min) img))
+    normalizer !px = (px - broadcastC s) / broadcastC (l - s)
     {-# INLINE normalizer #-}
 {-# INLINE normalize #-}
 
+
+-- | Type restricted version of `fromLists` that constructs an image using
+-- supplied representation.
+fromListsR :: Array arr cs e => arr -> [[Pixel cs e]] -> Image arr cs e
+fromListsR _ = fromLists
 
 -- | Generates a nested list of pixels from an image.
 --
diff --git a/src/Graphics/Image/ColorSpace.hs b/src/Graphics/Image/ColorSpace.hs
--- a/src/Graphics/Image/ColorSpace.hs
+++ b/src/Graphics/Image/ColorSpace.hs
@@ -3,9 +3,10 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 -- |
 -- Module      : Graphics.Image.ColorSpace
--- Copyright   : (c) Alexey Kuleshevich 2016
+-- Copyright   : (c) Alexey Kuleshevich 2017
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -13,7 +14,7 @@
 --
 module Graphics.Image.ColorSpace (
   -- * ColorSpace
-  ColorSpace, Pixel(..), Alpha, Opaque, Elevator(..),
+  ColorSpace, Pixel(..), AlphaSpace(..), Elevator(..),
   -- * Luma
   module Graphics.Image.ColorSpace.Luma,
   -- * RGB
@@ -36,6 +37,7 @@
   ) where
 
 import Data.Word
+import Data.Int
 import GHC.Float
 import Graphics.Image.Interface hiding (map)
 import Graphics.Image.ColorSpace.Binary
@@ -49,11 +51,11 @@
 import qualified Graphics.Image.Interface as I (map)
 
 
-
 -- Binary:
 
 -- | Convert any pixel to binary pixel.
-toPixelBinary :: (ColorSpace cs, Eq (Pixel cs e), Num e) => Pixel cs e -> Pixel Binary Bit
+toPixelBinary :: (Eq (Pixel cs e), Num (Pixel cs e))
+                 => Pixel cs e -> Pixel Binary Bit
 toPixelBinary px = if px == 0 then on else off
 {-# INLINE toPixelBinary #-}
 
@@ -111,7 +113,7 @@
 instance ToYA YCbCrA where
   
 instance ToRGB Y where
-  toPixelRGB (PixelY g) = fromChannel g
+  toPixelRGB (PixelY g) = broadcastC g
   {-# INLINE toPixelRGB #-}
 
 instance ToRGBA YA where
@@ -125,6 +127,7 @@
     getThird !v1 !v2 = i + 2*is + v1 - v2
     {-# INLINE getThird #-}
     getRGB h
+      | h < 0      = error ("HSI pixel is not properly scaled, Hue: "++show h')
       | h < 2*pi/3 = let !r = getFirst h (pi/3 - h)
                          !b = second
                          !g = getThird b r
@@ -205,216 +208,244 @@
 
 instance ToCMYKA RGBA where
 
-  
--- | Values are scaled to @[0, 255]@ range.
+
+dropDown :: forall a b. (Integral a, Bounded a, Integral b, Bounded b) => a -> b
+dropDown !e = fromIntegral $ fromIntegral e `div` ((maxBound :: a) `div`
+                                                   fromIntegral (maxBound :: b)) 
+{-# INLINE dropDown #-}
+
+raiseUp :: forall a b. (Integral a, Bounded a, Integral b, Bounded b) => a -> b
+raiseUp !e = fromIntegral e * ((maxBound :: b) `div` fromIntegral (maxBound :: a))
+{-# INLINE raiseUp #-}
+
+
+squashTo1 :: forall a b. (Fractional b, Integral a, Bounded a) => a -> b
+squashTo1 !e = fromIntegral e / fromIntegral (maxBound :: a)
+{-# INLINE squashTo1 #-}
+
+stretch :: forall a b. (RealFrac a, Floating a, Integral b, Bounded b) => a -> b
+stretch !e = round (fromIntegral (maxBound :: b) * clamp01 e)
+
+
+-- | Clamp a value to @[0, 1]@ range.
+clamp01 :: (Ord a, Floating a) => a -> a
+clamp01 !x = min (max 0 x) 1
+{-# INLINE clamp01 #-}
+
+
 instance Elevator Word8 where
 
   toWord8 = id
   {-# INLINE toWord8 #-}
-
-  toWord16 = fmap toWord16' where
-    toWord16' !e = fromIntegral e * ((maxBound :: Word16) `div` fromIntegral (maxBound :: Word8)) 
-    {-# INLINE toWord16' #-}
+  toWord16 = raiseUp
   {-# INLINE toWord16 #-}
-
-  toWord32 = fmap toWord32' where
-    toWord32' !e = fromIntegral e * ((maxBound :: Word32) `div` fromIntegral (maxBound :: Word8)) 
-    {-# INLINE toWord32' #-}
+  toWord32 = raiseUp
   {-# INLINE toWord32 #-}
-
-  toWord64 = fmap toWord64' where
-    toWord64' !e = fromIntegral e * ((maxBound :: Word64) `div` fromIntegral (maxBound :: Word8))
-    {-# INLINE toWord64' #-}
+  toWord64 = raiseUp
   {-# INLINE toWord64 #-}
-
-  toFloat = fmap toFloat' where
-    toFloat' !e = fromIntegral e / fromIntegral (maxBound :: Word8)
-    {-# INLINE toFloat' #-}
+  toFloat = squashTo1
   {-# INLINE toFloat #-}
-
-  toDouble = fmap toDouble' where
-    toDouble' !e = fromIntegral e / fromIntegral (maxBound :: Word8)
-    {-# INLINE toDouble' #-}
+  toDouble = squashTo1
   {-# INLINE toDouble #-}
-
   fromDouble = toWord8
   {-# INLINE fromDouble #-}
 
 
--- | Values are scaled to @[0, 65535]@ range.
 instance Elevator Word16 where
 
-  toWord8 = fmap toWord8' where
-    toWord8' !e = fromIntegral $ fromIntegral e `div` ((maxBound :: Word16) `div`
-                                                      fromIntegral (maxBound :: Word8)) 
-    {-# INLINE toWord8' #-}
+  toWord8 = dropDown
   {-# INLINE toWord8 #-}
-
   toWord16 = id
   {-# INLINE toWord16 #-}
-  
-  toWord32 = fmap toWord32' where
-    toWord32' !e = fromIntegral e * ((maxBound :: Word32) `div` fromIntegral (maxBound :: Word16)) 
-    {-# INLINE toWord32' #-}
+  toWord32 = raiseUp
   {-# INLINE toWord32 #-}
-
-  toWord64 = fmap toWord64' where
-    toWord64' !e = fromIntegral e * ((maxBound :: Word64) `div` fromIntegral (maxBound :: Word16))
-    {-# INLINE toWord64' #-}
+  toWord64 = raiseUp
   {-# INLINE toWord64 #-}
-
-  toFloat = fmap toFloat' where
-    toFloat' !e = fromIntegral e / fromIntegral (maxBound :: Word16)
-    {-# INLINE toFloat' #-}
+  toFloat = squashTo1
   {-# INLINE toFloat #-}
-
-  toDouble = fmap toDouble' where
-    toDouble' !e = fromIntegral e / fromIntegral (maxBound :: Word16)
-    {-# INLINE toDouble' #-}
+  toDouble = squashTo1
   {-# INLINE toDouble #-}
-
   fromDouble = toWord16
   {-# INLINE fromDouble #-}
 
 
--- | Values are scaled to @[0, 4294967295]@ range.
 instance Elevator Word32 where
 
-  toWord8 = fmap toWord8' where
-    toWord8' !e = fromIntegral $ fromIntegral e `div` ((maxBound :: Word32) `div`
-                                                       fromIntegral (maxBound :: Word8)) 
-    {-# INLINE toWord8' #-}
+  toWord8 = dropDown
   {-# INLINE toWord8 #-}
-
-  toWord16 = fmap toWord16' where
-    toWord16' !e = fromIntegral $ fromIntegral e `div` ((maxBound :: Word32) `div`
-                                                        fromIntegral (maxBound :: Word16)) 
-    {-# INLINE toWord16' #-}
+  toWord16 = dropDown
   {-# INLINE toWord16 #-}
-
   toWord32 = id
   {-# INLINE toWord32 #-}
-
-  toWord64 = fmap toWord64' where
-    toWord64' !e = fromIntegral e * ((maxBound :: Word64) `div` fromIntegral (maxBound :: Word32))
-    {-# INLINE toWord64' #-}
+  toWord64 = raiseUp
   {-# INLINE toWord64 #-}
-
-  toFloat = fmap toFloat' where
-    toFloat' !e = fromIntegral e / fromIntegral (maxBound :: Word32)
-    {-# INLINE toFloat' #-}
+  toFloat = squashTo1
   {-# INLINE toFloat #-}
-
-  toDouble = fmap toDouble' where
-    toDouble' !e = fromIntegral e / fromIntegral (maxBound :: Word32)
-    {-# INLINE toDouble' #-}
+  toDouble = squashTo1
   {-# INLINE toDouble #-}
-
   fromDouble = toWord32
   {-# INLINE fromDouble #-}
 
 
--- | Values are scaled to @[0, 18446744073709551615]@ range.
 instance Elevator Word64 where
 
-  toWord8 = fmap toWord8' where
-    toWord8' !e = fromIntegral $ fromIntegral e `div` ((maxBound :: Word64) `div`
-                                                       fromIntegral (maxBound :: Word8)) 
-    {-# INLINE toWord8' #-}
+  toWord8 = dropDown
   {-# INLINE toWord8 #-}
-
-  toWord16 = fmap toWord16' where
-    toWord16' !e = fromIntegral $ fromIntegral e `div` ((maxBound :: Word64) `div`
-                                                        fromIntegral (maxBound :: Word16)) 
-    {-# INLINE toWord16' #-}
+  toWord16 = dropDown
   {-# INLINE toWord16 #-}
-
-  toWord32 = fmap toWord32' where
-    toWord32' !e = fromIntegral $ fromIntegral e `div` ((maxBound :: Word64) `div`
-                                                        fromIntegral (maxBound :: Word32)) 
-    {-# INLINE toWord32' #-}
+  toWord32 = dropDown
   {-# INLINE toWord32 #-}
-
   toWord64 = id
   {-# INLINE toWord64 #-}
-
-  toFloat = fmap toFloat' where
-    toFloat' !e = fromIntegral e / fromIntegral (maxBound :: Word64)
-    {-# INLINE toFloat' #-}
+  toFloat = squashTo1
   {-# INLINE toFloat #-}
-
-  toDouble = fmap toDouble' where
-    toDouble' !e = fromIntegral e / fromIntegral (maxBound :: Word64)
-    {-# INLINE toDouble' #-}
+  toDouble = squashTo1
   {-# INLINE toDouble #-}
-
   fromDouble = toWord64
   {-# INLINE fromDouble #-}
 
 
--- | Values are scaled to @[0.0, 1.0]@ range.
-instance Elevator Float where
+instance Elevator Word where
 
-  toWord8 = fmap toWord8' where
-    toWord8' !e = round (fromIntegral (maxBound :: Word8) * e)
-    {-# INLINE toWord8' #-}
+  toWord8 = dropDown
   {-# INLINE toWord8 #-}
-
-  toWord16 = fmap toWord16' where
-    toWord16' !e = round (fromIntegral (maxBound :: Word16) * e)
-    {-# INLINE toWord16' #-}
+  toWord16 = dropDown
   {-# INLINE toWord16 #-}
-
-  toWord32 = fmap toWord32' where
-    toWord32' !e = round (fromIntegral (maxBound :: Word32) * e)
-    {-# INLINE toWord32' #-}
+  toWord32 = dropDown
   {-# INLINE toWord32 #-}
-
-  toWord64 = fmap toWord64' where
-    toWord64' !e = round (fromIntegral (maxBound :: Word64) * e)
-    {-# INLINE toWord64' #-}
+  toWord64 = fromIntegral
   {-# INLINE toWord64 #-}
-
-  toFloat = id
+  toFloat = squashTo1
   {-# INLINE toFloat #-}
-
-  toDouble = fmap float2Double
+  toDouble = squashTo1
   {-# INLINE toDouble #-}
+  fromDouble = stretch . clamp01
+  {-# INLINE fromDouble #-}
 
-  fromDouble = toFloat
+
+instance Elevator Int8 where
+
+  toWord8 = fromIntegral . (max 0)
+  {-# INLINE toWord8 #-}
+  toWord16 = raiseUp . (max 0)
+  {-# INLINE toWord16 #-}
+  toWord32 = raiseUp . (max 0)
+  {-# INLINE toWord32 #-}
+  toWord64 = raiseUp . (max 0)
+  {-# INLINE toWord64 #-}
+  toFloat = squashTo1 . (max 0)
+  {-# INLINE toFloat #-}
+  toDouble = squashTo1 . (max 0)
+  {-# INLINE toDouble #-}
+  fromDouble = stretch . clamp01
   {-# INLINE fromDouble #-}
 
 
--- | Values are scaled to @[0.0, 1.0]@ range.
-instance Elevator Double where
+instance Elevator Int16 where
 
-  toWord8 = fmap toWord8' where
-    toWord8' !e = round (fromIntegral (maxBound :: Word8) * e)
-    {-# INLINE toWord8' #-}
+  toWord8 = dropDown . (max 0)
   {-# INLINE toWord8 #-}
+  toWord16 = fromIntegral . (max 0)
+  {-# INLINE toWord16 #-}
+  toWord32 = raiseUp . (max 0)
+  {-# INLINE toWord32 #-}
+  toWord64 = raiseUp . (max 0)
+  {-# INLINE toWord64 #-}
+  toFloat = squashTo1 . (max 0)
+  {-# INLINE toFloat #-}
+  toDouble = squashTo1 . (max 0)
+  {-# INLINE toDouble #-}
+  fromDouble = stretch . clamp01
+  {-# INLINE fromDouble #-}
 
-  toWord16 = fmap toWord16' where
-    toWord16' !e = round (fromIntegral (maxBound :: Word16) * e)
-    {-# INLINE toWord16' #-}
+
+instance Elevator Int32 where
+
+  toWord8 = dropDown . (max 0)
+  {-# INLINE toWord8 #-}
+  toWord16 = dropDown . (max 0)
   {-# INLINE toWord16 #-}
+  toWord32 = fromIntegral . (max 0)
+  {-# INLINE toWord32 #-}
+  toWord64 = raiseUp . (max 0)
+  {-# INLINE toWord64 #-}
+  toFloat = squashTo1 . (max 0)
+  {-# INLINE toFloat #-}
+  toDouble = squashTo1 . (max 0)
+  {-# INLINE toDouble #-}
+  fromDouble = stretch . clamp01
+  {-# INLINE fromDouble #-}
 
-  toWord32 = fmap toWord32' where
-    toWord32' !e = round (fromIntegral (maxBound :: Word32) * e)
-    {-# INLINE toWord32' #-}
+
+instance Elevator Int64 where
+
+  toWord8 = dropDown . (max 0)
+  {-# INLINE toWord8 #-}
+  toWord16 = dropDown . (max 0)
+  {-# INLINE toWord16 #-}
+  toWord32 = dropDown . (max 0)
   {-# INLINE toWord32 #-}
+  toWord64 = fromIntegral . (max 0)
+  {-# INLINE toWord64 #-}
+  toFloat = squashTo1 . (max 0)
+  {-# INLINE toFloat #-}
+  toDouble = squashTo1 . (max 0)
+  {-# INLINE toDouble #-}
+  fromDouble = stretch . clamp01
+  {-# INLINE fromDouble #-}
 
-  toWord64 = fmap toWord64' where
-    toWord64' !e = round (fromIntegral (maxBound :: Word64) * e)
-    {-# INLINE toWord64' #-}
+
+instance Elevator Int where
+
+  toWord8 = dropDown . (max 0)
+  {-# INLINE toWord8 #-}
+  toWord16 = dropDown . (max 0)
+  {-# INLINE toWord16 #-}
+  toWord32 = dropDown . (max 0)
+  {-# INLINE toWord32 #-}
+  toWord64 = fromIntegral . (max 0)
   {-# INLINE toWord64 #-}
+  toFloat = squashTo1 . (max 0)
+  {-# INLINE toFloat #-}
+  toDouble = squashTo1 . (max 0)
+  {-# INLINE toDouble #-}
+  fromDouble = stretch . clamp01
+  {-# INLINE fromDouble #-}
 
-  toFloat = fmap double2Float
+
+instance Elevator Float where
+  toWord8 = stretch . clamp01
+  {-# INLINE toWord8 #-}
+  toWord16 = stretch . clamp01
+  {-# INLINE toWord16 #-}
+  toWord32 = stretch . clamp01
+  {-# INLINE toWord32 #-}
+  toWord64 = stretch . clamp01
+  {-# INLINE toWord64 #-}
+  toFloat = id
   {-# INLINE toFloat #-}
+  toDouble = float2Double
+  {-# INLINE toDouble #-}
+  fromDouble = toFloat
+  {-# INLINE fromDouble #-}
 
+instance Elevator Double where
+  toWord8 = stretch . clamp01
+  {-# INLINE toWord8 #-}
+  toWord16 = stretch . clamp01
+  {-# INLINE toWord16 #-}
+  toWord32 = stretch . clamp01
+  {-# INLINE toWord32 #-}
+  toWord64 = stretch . clamp01
+  {-# INLINE toWord64 #-}
+  toFloat = double2Float
+  {-# INLINE toFloat #-}
   toDouble = id
   {-# INLINE toDouble #-}
-
   fromDouble = id
   {-# INLINE fromDouble #-}
+
+
+
 
 
diff --git a/src/Graphics/Image/ColorSpace/Binary.hs b/src/Graphics/Image/ColorSpace/Binary.hs
--- a/src/Graphics/Image/ColorSpace/Binary.hs
+++ b/src/Graphics/Image/ColorSpace/Binary.hs
@@ -2,6 +2,8 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
 -- |
 -- Module      : Graphics.Image.ColorSpace.Binary
@@ -19,8 +21,8 @@
 import Data.Word (Word8)
 import Graphics.Image.Interface
 import Data.Typeable (Typeable)
-import qualified Data.Monoid as M (mappend, mempty)
-import qualified Data.Colour as C
+import Foreign.Ptr
+import Foreign.Storable
 
 -- | This is a Binary colorspace, pixel's of which can be created using
 -- these __/constructors/__:
@@ -51,7 +53,13 @@
 -- values of @0@ or @1@.
 newtype Bit = Bit Word8 deriving (Ord, Eq, Typeable)
 
+data instance Pixel Binary e = PixelBinary !e deriving (Ord, Eq)
 
+instance Show (Pixel Binary Bit) where
+  show (PixelBinary (Bit 0)) = "<Binary:(0)>"
+  show _                     = "<Binary:(1)>"
+
+
 -- | Represents value 'True' or @1@ in binary. Often also called a foreground
 -- pixel of an object.
 on :: Pixel Binary Bit
@@ -96,63 +104,110 @@
 {-# INLINE complement #-}
 
 
+instance ColorSpace Binary Bit where
+  type Components Binary Bit = Bit
 
-instance ColorSpace Binary where
-  type PixelElt Binary e = e
-  data Pixel Binary e = PixelBinary !e deriving (Ord, Eq)
+  broadcastC = PixelBinary
+  {-# INLINE broadcastC #-}
+  fromComponents = PixelBinary
+  {-# INLINE fromComponents #-}
+  toComponents (PixelBinary b) = b
+  {-# INLINE toComponents #-}
+  getPxC (PixelBinary b) _ = b
+  {-# INLINE getPxC #-}
+  setPxC (PixelBinary _) _ b = PixelBinary b
+  {-# INLINE setPxC #-}  
+  mapPxC f (PixelBinary b) = PixelBinary (f Binary b)
+  {-# INLINE mapPxC #-}
+  mapPx f (PixelBinary b) = PixelBinary (f b)
+  {-# INLINE mapPx #-}
+  zipWithPx f (PixelBinary b1) (PixelBinary b2) = PixelBinary (f b1 b2)
+  {-# INLINE zipWithPx #-}
+  foldrPx f z (PixelBinary b) = f b z
+  {-# INLINE foldrPx #-}
 
-  fromChannel = PixelBinary
-  {-# INLINE fromChannel #-}
 
-  fromElt = PixelBinary
-  {-# INLINE fromElt #-}
-
-  toElt (PixelBinary b) = b
-  {-# INLINE toElt #-}
+instance Elevator Bit where
+  toWord8 (Bit 0) = 0
+  toWord8 _       = maxBound
+  {-# INLINE toWord8 #-}
+  toWord16 (Bit 0) = 0
+  toWord16 _       = maxBound
+  {-# INLINE toWord16 #-}
+  toWord32 (Bit 0) = 0
+  toWord32 _       = maxBound
+  {-# INLINE toWord32 #-}
+  toWord64 (Bit 0) = 0
+  toWord64 _       = maxBound
+  {-# INLINE toWord64 #-}
+  toFloat (Bit 0) = 0
+  toFloat _       = 1
+  {-# INLINE toFloat #-}
+  toDouble (Bit 0) = 0
+  toDouble _       = 1
+  {-# INLINE toDouble #-}
+  fromDouble 0 = Bit 0
+  fromDouble _ = Bit 1
+  {-# INLINE fromDouble #-}
 
-  getPxCh (PixelBinary b) _ = b
-  {-# INLINE getPxCh #-}
   
-  chOp !f (PixelBinary b) = PixelBinary (f Binary b)
-  {-# INLINE chOp #-}
 
-  pxOp !f (PixelBinary b) = PixelBinary (f b)
-  {-# INLINE pxOp #-}
-
-  chApp (PixelBinary f) (PixelBinary b) = PixelBinary (f b)
-  {-# INLINE chApp #-}
-
-  pxFoldMap f (PixelBinary b) = f b `M.mappend` M.mempty
-  {-# INLINE pxFoldMap #-}
-
-  csColour _ = C.opaque C.black
-
-
-instance Show (Pixel Binary Bit) where
-  show (PixelBinary (Bit 0)) = "<Binary:(0)>"
-  show _                     = "<Binary:(1)>"
-
-
 instance Num Bit where
   (Bit 0) + (Bit 0) = Bit 0
   _       + _       = Bit 1
   {-# INLINE (+) #-}
-  
   _ - (Bit 1) = Bit 0
   _ - _       = Bit 1
   {-# INLINE (-) #-}
-  
   _       * (Bit 0) = Bit 0
   (Bit 0) * _       = Bit 0
   _       * _       = Bit 1
   {-# INLINE (*) #-}
-  
   abs         = id
   {-# INLINE abs #-}
-  
   signum      = id
   {-# INLINE signum #-}
-  
   fromInteger 0 = Bit 0
   fromInteger _ = Bit 1
   {-# INLINE fromInteger #-}
+
+
+instance Num (Pixel Binary Bit) where
+  (+)         = zipWithPx (+)
+  {-# INLINE (+) #-}
+  (-)         = zipWithPx (-)
+  {-# INLINE (-) #-}
+  (*)         = zipWithPx (*)
+  {-# INLINE (*) #-}
+  abs         = mapPx abs
+  {-# INLINE abs #-}
+  signum      = mapPx signum
+  {-# INLINE signum #-}
+  fromInteger = broadcastC . fromInteger
+  {-# INLINE fromInteger #-}
+
+
+instance Storable Bit where
+
+  sizeOf _ = sizeOf (undefined :: Word8)
+  alignment _ = alignment (undefined :: Word8)
+  peek p = do
+    q <- return $ castPtr p
+    b <- peek q
+    return (Bit b)
+  poke p (Bit b) = do
+    q <- return $ castPtr p
+    poke q b
+
+
+instance Storable (Pixel Binary Bit) where
+
+  sizeOf _ = sizeOf (undefined :: Bit)
+  alignment _ = alignment (undefined :: Bit)
+  peek p = do
+    q <- return $ castPtr p
+    b <- peek q
+    return (PixelBinary b)
+  poke p (PixelBinary b) = do
+    q <- return $ castPtr p
+    poke q b
diff --git a/src/Graphics/Image/ColorSpace/CMYK.hs b/src/Graphics/Image/ColorSpace/CMYK.hs
--- a/src/Graphics/Image/ColorSpace/CMYK.hs
+++ b/src/Graphics/Image/ColorSpace/CMYK.hs
@@ -2,10 +2,12 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
 -- |
 -- Module      : Graphics.Image.ColorSpace.CMYK
--- Copyright   : (c) Alexey Kuleshevich 2016
+-- Copyright   : (c) Alexey Kuleshevich 2017
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -17,12 +19,18 @@
   ) where
 
 import Prelude hiding (map)
-import Graphics.Image.Interface
+import Control.Applicative
+import Data.Foldable
 import Data.Typeable (Typeable)
-import qualified Data.Monoid as M (mappend)
-import qualified Data.Colour as C
-import qualified Data.Colour.Names as C
+import Foreign.Ptr
+import Foreign.Storable
 
+import Graphics.Image.Interface
+
+------------
+--- CMYK ---
+------------
+
 -- | Cyan, Magenta, Yellow and Black color space.
 data CMYK = CyanCMYK -- ^ Cyan
           | MagCMYK  -- ^ Magenta
@@ -30,6 +38,141 @@
           | KeyCMYK  -- ^ Key (Black)
           deriving (Eq, Enum, Typeable)
 
+instance Show CMYK where
+  show CyanCMYK = "Cyan"
+  show MagCMYK  = "Magenta"
+  show YelCMYK  = "Yellow"
+  show KeyCMYK  = "Black"
+
+
+instance Show e => Show (Pixel CMYK e) where
+  show (PixelCMYK c m y k) = "<CMYK:("++show c++"|"++show m++"|"++show y++"|"++show k++")>"
+
+
+data instance Pixel CMYK e = PixelCMYK !e !e !e !e deriving Eq
+
+instance (Elevator e, Typeable e) => ColorSpace CMYK e where
+  type Components CMYK e = (e, e, e, e)
+  
+  fromComponents !(c, m, y, k) = PixelCMYK c m y k
+  {-# INLINE fromComponents #-}
+  toComponents (PixelCMYK c m y k) = (c, m, y, k)
+  {-# INLINE toComponents #-}
+  broadcastC !e = PixelCMYK e e e e
+  {-# INLINE broadcastC #-}
+  getPxC (PixelCMYK c _ _ _) CyanCMYK = c
+  getPxC (PixelCMYK _ m _ _) MagCMYK  = m
+  getPxC (PixelCMYK _ _ y _) YelCMYK  = y
+  getPxC (PixelCMYK _ _ _ k) KeyCMYK  = k
+  {-# INLINE setPxC #-}
+  setPxC (PixelCMYK _ m y k) CyanCMYK c = PixelCMYK c m y k
+  setPxC (PixelCMYK c _ y k) MagCMYK  m = PixelCMYK c m y k
+  setPxC (PixelCMYK c m _ k) YelCMYK  y = PixelCMYK c m y k
+  setPxC (PixelCMYK c m y _) KeyCMYK  k = PixelCMYK c m y k
+  {-# INLINE getPxC #-}
+  mapPxC f (PixelCMYK c m y k) =
+    PixelCMYK (f CyanCMYK c) (f MagCMYK m) (f YelCMYK y) (f KeyCMYK k)
+  {-# INLINE mapPxC #-}
+  mapPx = fmap
+  {-# INLINE mapPx #-}
+  zipWithPx = liftA2
+  {-# INLINE zipWithPx #-}
+  foldlPx = foldl'
+  {-# INLINE foldlPx #-}
+
+
+instance Functor (Pixel CMYK) where
+  fmap f (PixelCMYK c m y k) = PixelCMYK (f c) (f m) (f y) (f k)
+  {-# INLINE fmap #-}
+
+
+instance Applicative (Pixel CMYK) where
+  pure !e = PixelCMYK e e e e
+  {-# INLINE pure #-}
+  (PixelCMYK fc fm fy fk) <*> (PixelCMYK c m y k) = PixelCMYK (fc c) (fm m) (fy y) (fk k)
+  {-# INLINE (<*>) #-}
+
+
+instance Foldable (Pixel CMYK) where
+  foldr f !z (PixelCMYK c m y k) = f c (f m (f y (f k z)))
+  {-# INLINE foldr #-}
+
+
+instance Num e => Num (Pixel CMYK e) where
+  (+)         = liftA2 (+)
+  {-# INLINE (+) #-}
+  (-)         = liftA2 (-)
+  {-# INLINE (-) #-}
+  (*)         = liftA2 (*)
+  {-# INLINE (*) #-}
+  abs         = liftA abs
+  {-# INLINE abs #-}
+  signum      = liftA signum
+  {-# INLINE signum #-}
+  fromInteger = pure . fromInteger
+  {-# INLINE fromInteger #-}
+
+
+instance Fractional e => Fractional (Pixel CMYK e) where
+  (/)          = liftA2 (/)
+  {-# INLINE (/) #-}
+  recip        = liftA recip
+  {-# INLINE recip #-}
+  fromRational = pure . fromRational
+  {-# INLINE fromRational #-}
+
+
+instance Floating e => Floating (Pixel CMYK e) where
+  pi      = pure pi
+  {-# INLINE pi #-}
+  exp     = liftA exp
+  {-# INLINE exp #-}
+  log     = liftA log
+  {-# INLINE log #-}
+  sin     = liftA sin
+  {-# INLINE sin #-}
+  cos     = liftA cos
+  {-# INLINE cos #-}
+  asin    = liftA asin
+  {-# INLINE asin #-}
+  atan    = liftA atan
+  {-# INLINE atan #-}
+  acos    = liftA acos
+  {-# INLINE acos #-}
+  sinh    = liftA sinh
+  {-# INLINE sinh #-}
+  cosh    = liftA cosh
+  {-# INLINE cosh #-}
+  asinh   = liftA asinh
+  {-# INLINE asinh #-}
+  atanh   = liftA atanh
+  {-# INLINE atanh #-}
+  acosh   = liftA acosh
+  {-# INLINE acosh #-}
+
+
+instance Storable e => Storable (Pixel CMYK e) where
+
+  sizeOf _ = 3 * sizeOf (undefined :: e)
+  alignment _ = alignment (undefined :: e)
+  peek p = do
+    q <- return $ castPtr p
+    c <- peek q
+    m <- peekElemOff q 1
+    y <- peekElemOff q 2
+    k <- peekElemOff q 3
+    return (PixelCMYK c m y k)
+  poke p (PixelCMYK c m y k) = do
+    q <- return $ castPtr p
+    poke q c
+    pokeElemOff q 1 m
+    pokeElemOff q 2 y
+    pokeElemOff q 3 k
+
+-------------
+--- CMYKA ---
+-------------
+
 -- | Cyan, Magenta, Yellow and Black color space with Alpha channel.
 data CMYKA = CyanCMYKA  -- ^ Cyan
            | MagCMYKA   -- ^ Magenta
@@ -40,7 +183,7 @@
 
 
 -- | Conversion to `CMYK` color space.
-class ColorSpace cs => ToCMYK cs where
+class ColorSpace cs Double => ToCMYK cs where
 
   -- | Convert to a `CMYK` pixel.
   toPixelCMYK :: Pixel cs Double -> Pixel CMYK Double
@@ -53,8 +196,9 @@
   {-# INLINE toImageCMYK #-}
 
 
+
 -- | Conversion to `CMYKA` from another color space with Alpha channel.
-class (ToCMYK (Opaque cs), Alpha cs) => ToCMYKA cs where
+class (ToCMYK (Opaque cs), AlphaSpace cs Double) => ToCMYKA cs where
 
   -- | Convert to a `CMYKA` pixel.
   toPixelCMYKA :: Pixel cs Double -> Pixel CMYKA Double
@@ -68,85 +212,55 @@
   toImageCMYKA = map toPixelCMYKA
   {-# INLINE toImageCMYKA #-}
 
-  
-instance ColorSpace CMYK where
-  type PixelElt CMYK e = (e, e, e, e)
-  data Pixel CMYK e = PixelCMYK !e !e !e !e deriving Eq
+data instance Pixel CMYKA e = PixelCMYKA !e !e !e !e !e deriving Eq
 
-  fromChannel !e = PixelCMYK e e e e
-  {-# INLINE fromChannel #-}
 
-  fromElt !(c, m, y, k) = PixelCMYK c m y k
-  {-# INLINE fromElt #-}
-
-  toElt (PixelCMYK c m y k) = (c, m, y, k)
-  {-# INLINE toElt #-}
-
-  getPxCh (PixelCMYK c _ _ _) CyanCMYK = c
-  getPxCh (PixelCMYK _ m _ _) MagCMYK  = m
-  getPxCh (PixelCMYK _ _ y _) YelCMYK  = y
-  getPxCh (PixelCMYK _ _ _ k) KeyCMYK  = k
-  {-# INLINE getPxCh #-}
-  
-  chOp !f (PixelCMYK c m y k) =
-    PixelCMYK (f CyanCMYK c) (f MagCMYK m) (f YelCMYK y) (f KeyCMYK k)
-  {-# INLINE chOp #-}
-
-  pxOp !f (PixelCMYK c m y k) = PixelCMYK (f c) (f m) (f y) (f k)
-  {-# INLINE pxOp #-}
-
-  chApp (PixelCMYK fc fm fy fk) (PixelCMYK c m y k) = PixelCMYK (fc c) (fm m) (fy y) (fk k)
-  {-# INLINE chApp #-}
-
-  pxFoldMap f (PixelCMYK c m y k) = f c `M.mappend` f m `M.mappend` f y `M.mappend` f k
-  {-# INLINE pxFoldMap #-}
+instance Show CMYKA where
+  show CyanCMYKA  = "Cyan"
+  show MagCMYKA   = "Magenta"
+  show YelCMYKA   = "Yellow"
+  show KeyCMYKA   = "Black"
+  show AlphaCMYKA = "Alpha"
+ 
 
-  csColour CyanCMYK = C.opaque C.cyan
-  csColour MagCMYK  = C.opaque C.magenta
-  csColour YelCMYK  = C.opaque C.yellow
-  csColour KeyCMYK  = C.opaque C.black
+instance Show e => Show (Pixel CMYKA e) where
+  show (PixelCMYKA c m y k a) =
+    "<CMYKA:("++show c++"|"++show m++"|"++show y++"|"++show k++"|"++show a++")>"
 
 
-instance ColorSpace CMYKA where
-  type PixelElt CMYKA e = (e, e, e, e, e)
-  data Pixel CMYKA e = PixelCMYKA !e !e !e !e !e deriving Eq
-
-  fromChannel !e = PixelCMYKA e e e e e
-  {-# INLINE fromChannel #-}
-
-  fromElt (c, m, y, k, a) = PixelCMYKA c m y k a
-  {-# INLINE fromElt #-}
-
-  toElt (PixelCMYKA c m y k a) = (c, m, y, k, a)
-  {-# INLINE toElt #-}
-
-  getPxCh (PixelCMYKA c _ _ _ _) CyanCMYKA  = c
-  getPxCh (PixelCMYKA _ m _ _ _) MagCMYKA   = m
-  getPxCh (PixelCMYKA _ _ y _ _) YelCMYKA   = y
-  getPxCh (PixelCMYKA _ _ _ k _) KeyCMYKA   = k
-  getPxCh (PixelCMYKA _ _ _ _ a) AlphaCMYKA = a
-  {-# INLINE getPxCh #-}
+instance (Elevator e, Typeable e) => ColorSpace CMYKA e where
+  type Components CMYKA e = (e, e, e, e, e)
   
-  chOp !f (PixelCMYKA c m y k a) =
+  fromComponents !(c, m, y, k, a) = PixelCMYKA c m y k a
+  {-# INLINE fromComponents #-}
+  toComponents (PixelCMYKA c m y k a) = (c, m, y, k, a)
+  {-# INLINE toComponents #-}
+  broadcastC !e = PixelCMYKA e e e e e
+  {-# INLINE broadcastC #-}
+  getPxC (PixelCMYKA c _ _ _ _) CyanCMYKA  = c
+  getPxC (PixelCMYKA _ m _ _ _) MagCMYKA   = m
+  getPxC (PixelCMYKA _ _ y _ _) YelCMYKA   = y
+  getPxC (PixelCMYKA _ _ _ k _) KeyCMYKA   = k
+  getPxC (PixelCMYKA _ _ _ _ a) AlphaCMYKA = a
+  {-# INLINE getPxC #-}
+  setPxC (PixelCMYKA _ m y k a) CyanCMYKA  c = PixelCMYKA c m y k a
+  setPxC (PixelCMYKA c _ y k a) MagCMYKA   m = PixelCMYKA c m y k a
+  setPxC (PixelCMYKA c m _ k a) YelCMYKA   y = PixelCMYKA c m y k a
+  setPxC (PixelCMYKA c m y _ a) KeyCMYKA   k = PixelCMYKA c m y k a
+  setPxC (PixelCMYKA c m y k _) AlphaCMYKA a = PixelCMYKA c m y k a
+  {-# INLINE setPxC #-}
+  mapPxC f (PixelCMYKA c m y k a) =
     PixelCMYKA (f CyanCMYKA c) (f MagCMYKA m) (f YelCMYKA y) (f KeyCMYKA k) (f AlphaCMYKA a)
-  {-# INLINE chOp #-}
-
-  pxOp !f (PixelCMYKA c m y k a) = PixelCMYKA (f c) (f m) (f y) (f k) (f a)
-  {-# INLINE pxOp #-}
-
-  chApp (PixelCMYKA fc fm fy fk fa) (PixelCMYKA c m y k a) =
-    PixelCMYKA (fc c) (fm m) (fy y) (fk k) (fa a)
-  {-# INLINE chApp #-}
-
-  pxFoldMap f (PixelCMYKA c m y k a) =
-    f c `M.mappend` f m `M.mappend` f y `M.mappend` f k `M.mappend` f a
-  {-# INLINE pxFoldMap #-}
-
-  csColour AlphaCMYKA = C.opaque C.grey
-  csColour ch         = csColour $ opaque ch
+  {-# INLINE mapPxC #-}
+  mapPx = fmap
+  {-# INLINE mapPx #-}
+  zipWithPx = liftA2
+  {-# INLINE zipWithPx #-}
+  foldlPx = foldl'
+  {-# INLINE foldlPx #-}
 
 
-instance Alpha CMYKA where
+instance (Elevator e, Typeable e) => AlphaSpace CMYKA e where
   type Opaque CMYKA = CMYK
 
   getAlpha (PixelCMYKA _ _ _ _ a) = a
@@ -158,32 +272,94 @@
   dropAlpha (PixelCMYKA c m y k _) = PixelCMYK c m y k
   {-# INLINE dropAlpha #-}
 
-  opaque CyanCMYKA  = CyanCMYK
-  opaque MagCMYKA   = MagCMYK
-  opaque YelCMYKA   = YelCMYK
-  opaque KeyCMYKA   = KeyCMYK
-  opaque AlphaCMYKA = error "Data.Image.ColorSpace.CMYK (Alpha.opaque)"
-  
 
-instance Show CMYK where
-  show CyanCMYK = "Cyan"
-  show MagCMYK  = "Magenta"
-  show YelCMYK  = "Yellow"
-  show KeyCMYK  = "Black"
+instance Functor (Pixel CMYKA) where
+  fmap f (PixelCMYKA c m y k a) = PixelCMYKA (f c) (f m) (f y) (f k) (f a)
+  {-# INLINE fmap #-}
 
 
-instance Show CMYKA where
-  show AlphaCMYKA = "Alpha"
-  show ch         = show $ opaque ch
+instance Applicative (Pixel CMYKA) where
+  pure !e = PixelCMYKA e e e e e
+  {-# INLINE pure #-}
+  (PixelCMYKA fc fm fy fk fa) <*> (PixelCMYKA c m y k a) =
+    PixelCMYKA (fc c) (fm m) (fy y) (fk k) (fa a)
+  {-# INLINE (<*>) #-}
 
-  
-instance Show e => Show (Pixel CMYK e) where
-  show (PixelCMYK c m y k) = "<CMYK:("++show c++"|"++show m++"|"++show y++"|"++show k++")>"
 
+instance Foldable (Pixel CMYKA) where
+  foldr f !z (PixelCMYKA c m y k a) = f c (f m (f y (f k (f a z))))
+  {-# INLINE foldr #-}
 
-instance Show e => Show (Pixel CMYKA e) where
-  show (PixelCMYKA c m y k a) =
-    "<CMYKA:("++show c++"|"++show m++"|"++show y++"|"++show k++"|"++show a++")>"
 
+instance Num e => Num (Pixel CMYKA e) where
+  (+)         = liftA2 (+)
+  {-# INLINE (+) #-}
+  (-)         = liftA2 (-)
+  {-# INLINE (-) #-}
+  (*)         = liftA2 (*)
+  {-# INLINE (*) #-}
+  abs         = liftA abs
+  {-# INLINE abs #-}
+  signum      = liftA signum
+  {-# INLINE signum #-}
+  fromInteger = pure . fromInteger
+  {-# INLINE fromInteger #-}
 
 
+instance Fractional e => Fractional (Pixel CMYKA e) where
+  (/)          = liftA2 (/)
+  {-# INLINE (/) #-}
+  recip        = liftA recip
+  {-# INLINE recip #-}
+  fromRational = pure . fromRational
+  {-# INLINE fromRational #-}
+
+
+instance Floating e => Floating (Pixel CMYKA e) where
+  pi      = pure pi
+  {-# INLINE pi #-}
+  exp     = liftA exp
+  {-# INLINE exp #-}
+  log     = liftA log
+  {-# INLINE log #-}
+  sin     = liftA sin
+  {-# INLINE sin #-}
+  cos     = liftA cos
+  {-# INLINE cos #-}
+  asin    = liftA asin
+  {-# INLINE asin #-}
+  atan    = liftA atan
+  {-# INLINE atan #-}
+  acos    = liftA acos
+  {-# INLINE acos #-}
+  sinh    = liftA sinh
+  {-# INLINE sinh #-}
+  cosh    = liftA cosh
+  {-# INLINE cosh #-}
+  asinh   = liftA asinh
+  {-# INLINE asinh #-}
+  atanh   = liftA atanh
+  {-# INLINE atanh #-}
+  acosh   = liftA acosh
+  {-# INLINE acosh #-}
+
+
+instance Storable e => Storable (Pixel CMYKA e) where
+
+  sizeOf _ = 3 * sizeOf (undefined :: e)
+  alignment _ = alignment (undefined :: e)
+  peek p = do
+    q <- return $ castPtr p
+    c <- peek q
+    m <- peekElemOff q 1
+    y <- peekElemOff q 2
+    k <- peekElemOff q 3
+    a <- peekElemOff q 4
+    return (PixelCMYKA c m y k a)
+  poke p (PixelCMYKA c m y k a) = do
+    q <- return $ castPtr p
+    poke q c
+    pokeElemOff q 1 m
+    pokeElemOff q 2 y
+    pokeElemOff q 3 k
+    pokeElemOff q 4 a
diff --git a/src/Graphics/Image/ColorSpace/Complex.hs b/src/Graphics/Image/ColorSpace/Complex.hs
--- a/src/Graphics/Image/ColorSpace/Complex.hs
+++ b/src/Graphics/Image/ColorSpace/Complex.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE FlexibleContexts #-}
 #if __GLASGOW_HASKELL__ >= 800
   {-# OPTIONS_GHC -Wno-redundant-constraints #-}
 #endif
@@ -20,7 +21,7 @@
   conjugate
   ) where
 
-import Graphics.Image.Interface (ColorSpace(..))
+import Graphics.Image.Interface (Pixel)
 import Control.Applicative
 import Data.Complex (Complex(..))
 import qualified Data.Complex as C hiding (Complex(..))
@@ -33,50 +34,51 @@
 --
 -- @ PixelRGB 4 8 6 '+:' PixelRGB 7 1 1 __==__ PixelRGB (4 ':+' 7) (8 ':+' 1) (6 ':+' 1) @
 --
-(+:) :: ColorSpace cs => Pixel cs e -> Pixel cs e -> Pixel cs (Complex e)
+(+:) :: Applicative (Pixel cs) => Pixel cs e -> Pixel cs e -> Pixel cs (Complex e)
 (+:) = liftA2 (:+)
 {-# INLINE (+:) #-}
 
 -- | Extracts the real part of a complex pixel.
-realPart :: (ColorSpace cs, RealFloat e) => Pixel cs (Complex e) -> Pixel cs e
+realPart :: (Applicative (Pixel cs), RealFloat e) => Pixel cs (Complex e) -> Pixel cs e
 realPart = liftA C.realPart
 {-# INLINE realPart #-}
 
 -- | Extracts the imaginary part of a complex pixel.
-imagPart :: (ColorSpace cs, RealFloat e) => Pixel cs (Complex e) -> Pixel cs e
+imagPart :: (Applicative (Pixel cs), RealFloat e) => Pixel cs (Complex e) -> Pixel cs e
 imagPart = liftA C.imagPart
 {-# INLINE imagPart #-}
 
 -- | Form a complex pixel from polar components of magnitude and phase.
-mkPolar :: (ColorSpace cs, RealFloat e) => Pixel cs e -> Pixel cs e -> Pixel cs (Complex e)
+mkPolar :: (Applicative (Pixel cs), RealFloat e) =>
+           Pixel cs e -> Pixel cs e -> Pixel cs (Complex e)
 mkPolar = liftA2 C.mkPolar
 {-# INLINE mkPolar #-}
 
 -- | @'cis' t@ is a complex pixel with magnitude 1 and phase t (modulo @2*'pi'@).
-cis :: (ColorSpace cs, RealFloat e) => Pixel cs e -> Pixel cs (Complex e)
+cis :: (Applicative (Pixel cs), RealFloat e) => Pixel cs e -> Pixel cs (Complex e)
 cis = liftA C.cis
 {-# INLINE cis #-}
 
 -- | The function @'polar'@ takes a complex pixel and returns a (magnitude, phase)
 -- pair of pixels in canonical form: the magnitude is nonnegative, and the phase
 -- in the range @(-'pi', 'pi']@; if the magnitude is zero, then so is the phase.
-polar :: (ColorSpace cs, RealFloat e) => Pixel cs (Complex e) -> (Pixel cs e, Pixel cs e)
+polar :: (Applicative (Pixel cs), RealFloat e) => Pixel cs (Complex e) -> (Pixel cs e, Pixel cs e)
 polar !zPx = (magnitude zPx, phase zPx)
 {-# INLINE polar #-}
 
 -- | The nonnegative magnitude of a complex pixel.
-magnitude :: (ColorSpace cs, RealFloat e) => Pixel cs (Complex e) -> Pixel cs e
+magnitude :: (Applicative (Pixel cs), RealFloat e) => Pixel cs (Complex e) -> Pixel cs e
 magnitude = liftA C.magnitude
 {-# INLINE magnitude #-}
 
 -- | The phase of a complex pixel, in the range @(-'pi', 'pi']@. If the
 -- magnitude is zero, then so is the phase.
-phase :: (ColorSpace cs, RealFloat e) => Pixel cs (Complex e) -> Pixel cs e
+phase :: (Applicative (Pixel cs), RealFloat e) => Pixel cs (Complex e) -> Pixel cs e
 phase = liftA C.phase
 {-# INLINE phase #-}
 
 -- | The conjugate of a complex pixel.
-conjugate :: (ColorSpace cs, RealFloat e) => Pixel cs (Complex e) -> Pixel cs (Complex e)
+conjugate :: (Applicative (Pixel cs), RealFloat e) => Pixel cs (Complex e) -> Pixel cs (Complex e)
 conjugate = liftA C.conjugate
 {-# INLINE conjugate #-}
 
diff --git a/src/Graphics/Image/ColorSpace/Gray.hs b/src/Graphics/Image/ColorSpace/Gray.hs
--- a/src/Graphics/Image/ColorSpace/Gray.hs
+++ b/src/Graphics/Image/ColorSpace/Gray.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
 -- |
@@ -16,22 +17,149 @@
   Gray(..), Pixel(..), toGrayImages, fromGrayImages
   ) where
 
-import Prelude hiding (map, zipWith)
-import qualified Prelude as P (map)
-import Graphics.Image.Interface
+import Prelude as P
+import Control.Applicative
+import Data.Foldable
 import Data.Typeable (Typeable)
-import qualified Data.Monoid as M (mappend, mempty)
-import qualified Data.Colour as C
-import qualified Data.Colour.Names as C
+import Foreign.Ptr
+import Foreign.Storable
 
--- ^ This is a signgle channel colorspace, that is designed to hold any channel
--- from any other colorspace, hence it is not convertible to and from, but
--- rather is here to allow separation of channels from other multichannel
--- colorspaces. If you are looking for a true grayscale colorspace
+import Graphics.Image.Interface as I
+
+-- ^ This is a single channel colorspace, that is designed to separate Gray
+-- level values from other types of colorspace, hence it is not convertible to
+-- or from, but rather is here to allow operation on arbirtary single channel
+-- images. If you are looking for a true grayscale colorspace
 -- 'Graphics.Image.ColorSpace.Luma.Y' should be used instead.
 data Gray = Gray deriving (Eq, Enum, Show, Typeable)
 
 
+data instance Pixel Gray e = PixelGray !e deriving (Ord, Eq)
+
+
+instance Show e => Show (Pixel Gray e) where
+  show (PixelGray g) = "<Gray:("++show g++")>"
+
+
+instance (Elevator e, Typeable e) => ColorSpace Gray e where
+  type Components Gray e = e
+
+  broadcastC = PixelGray
+  {-# INLINE broadcastC #-}
+  fromComponents = PixelGray
+  {-# INLINE fromComponents #-}
+  toComponents (PixelGray g) = g
+  {-# INLINE toComponents #-}
+  getPxC (PixelGray g) Gray = g
+  {-# INLINE getPxC #-}
+  setPxC (PixelGray _) Gray g = PixelGray g
+  {-# INLINE setPxC #-}
+  mapPxC f (PixelGray g) = PixelGray (f Gray g)
+  {-# INLINE mapPxC #-}
+  mapPx = fmap
+  {-# INLINE mapPx #-}
+  zipWithPx = liftA2
+  {-# INLINE zipWithPx #-}
+  foldlPx = foldl'
+  {-# INLINE foldlPx #-}
+
+
+instance Functor (Pixel Gray) where
+  fmap f (PixelGray g) = PixelGray (f g)
+  {-# INLINE fmap #-}
+
+
+instance Applicative (Pixel Gray) where
+  pure = PixelGray
+  {-# INLINE pure #-}
+  (PixelGray fg) <*> (PixelGray g) = PixelGray (fg g)
+  {-# INLINE (<*>) #-}
+
+
+instance Foldable (Pixel Gray) where
+  foldr f !z (PixelGray g) = f g z
+  {-# INLINE foldr #-}
+
+
+instance Monad (Pixel Gray) where
+
+  return = PixelGray
+  {-# INLINE return #-}
+
+  (>>=) (PixelGray g) f = f g
+  {-# INLINE (>>=) #-}
+
+
+instance Num e => Num (Pixel Gray e) where
+  (+)         = liftA2 (+)
+  {-# INLINE (+) #-}
+  
+  (-)         = liftA2 (-)
+  {-# INLINE (-) #-}
+  
+  (*)         = liftA2 (*)
+  {-# INLINE (*) #-}
+  
+  abs         = liftA abs
+  {-# INLINE abs #-}
+  
+  signum      = liftA signum
+  {-# INLINE signum #-}
+  
+  fromInteger = pure . fromInteger
+  {-# INLINE fromInteger #-}
+
+
+instance Fractional e => Fractional (Pixel Gray e) where
+  (/)          = liftA2 (/)
+  {-# INLINE (/) #-}
+  recip        = liftA recip
+  {-# INLINE recip #-}
+  fromRational = pure . fromRational
+  {-# INLINE fromRational #-}
+
+
+instance Floating e => Floating (Pixel Gray e) where
+  pi      = pure pi
+  {-# INLINE pi #-}
+  exp     = liftA exp
+  {-# INLINE exp #-}
+  log     = liftA log
+  {-# INLINE log #-}
+  sin     = liftA sin
+  {-# INLINE sin #-}
+  cos     = liftA cos
+  {-# INLINE cos #-}
+  asin    = liftA asin
+  {-# INLINE asin #-}
+  atan    = liftA atan
+  {-# INLINE atan #-}
+  acos    = liftA acos
+  {-# INLINE acos #-}
+  sinh    = liftA sinh
+  {-# INLINE sinh #-}
+  cosh    = liftA cosh
+  {-# INLINE cosh #-}
+  asinh   = liftA asinh
+  {-# INLINE asinh #-}
+  atanh   = liftA atanh
+  {-# INLINE atanh #-}
+  acosh   = liftA acosh
+  {-# INLINE acosh #-}
+
+
+instance Storable e => Storable (Pixel Gray e) where
+
+  sizeOf _ = sizeOf (undefined :: e)
+  alignment _ = alignment (undefined :: e)
+  peek p = do
+    q <- return $ castPtr p
+    g <- peek q
+    return (PixelGray g)
+  poke p (PixelGray g) = do
+    q <- return $ castPtr p
+    poke q g
+
 -- | Separate an image into a list of images with 'Gray' pixels containing every
 -- channel from the source image.
 --
@@ -45,7 +173,7 @@
 --
 toGrayImages :: (Array arr cs e, Array arr Gray e) => Image arr cs e -> [Image arr Gray e]
 toGrayImages !img = P.map getCh (enumFrom (toEnum 0)) where
-  getCh !ch = map (PixelGray . (`getPxCh` ch)) img
+  getCh !ch = I.map (PixelGray . (`getPxC` ch)) img
   {-# INLINE getCh #-}
 {-# INLINE toGrayImages #-}
 
@@ -61,61 +189,17 @@
 --
 -- It is worth noting though, despite that separating image channels can be sometimes
 -- pretty useful, the same effect as above can be achieved in a much simpler and
--- more efficient way:
+-- a more efficient way:
 --
 -- @ map (\(PixelRGB r g b) -> PixelRGB r b g) frog @
 --
 fromGrayImages :: forall arr cs e . (Array arr Gray e, Array arr cs e) =>
                   [Image arr Gray e] -> [cs] -> Image arr cs e
-fromGrayImages = fromGrays (singleton (fromChannel 0)) where
-  updateCh ch px (PixelGray e) = chOp (\ !ch' !e' -> if ch' == ch then e else e') px
+fromGrayImages = fromGrays 0 where
+  updateCh ch px (PixelGray e) = setPxC px ch e
   {-# INLINE updateCh #-}
   fromGrays img []     _      = img
   fromGrays img _      []     = img
-  fromGrays img (i:is) (c:cs) = fromGrays (zipWith (updateCh c) img i) is cs
+  fromGrays img (i:is) (c:cs) = fromGrays (I.zipWith (updateCh c) img i) is cs
   {-# INLINE fromGrays #-}
 {-# INLINE fromGrayImages #-}
-
-
-instance ColorSpace Gray where
-  type PixelElt Gray e = e
-  data Pixel Gray e = PixelGray !e deriving (Ord, Eq)
-
-  fromChannel = PixelGray
-  {-# INLINE fromChannel #-}
-
-  fromElt = PixelGray
-  {-# INLINE fromElt #-}
-
-  toElt (PixelGray g) = g
-  {-# INLINE toElt #-}
-
-  getPxCh (PixelGray g) _ = g
-  {-# INLINE getPxCh #-}
-  
-  chOp !f (PixelGray g) = PixelGray (f Gray g)
-  {-# INLINE chOp #-}
-  
-  pxOp !f (PixelGray g) = PixelGray (f g)
-  {-# INLINE pxOp #-}
-
-  chApp (PixelGray f) (PixelGray g) = PixelGray (f g)
-  {-# INLINE chApp #-}
-
-  pxFoldMap f (PixelGray g) = f g `M.mappend` M.mempty
-  {-# INLINE pxFoldMap #-}
-
-  csColour _ = C.opaque C.gray
-
-  
-instance Show e => Show (Pixel Gray e) where
-  show (PixelGray g) = "<Gray:("++show g++")>"
-
-
-instance Monad (Pixel Gray) where
-
-  return = PixelGray
-  {-# INLINE return #-}
-
-  (>>=) (PixelGray g) f = f g
-  {-# INLINE (>>=) #-}
diff --git a/src/Graphics/Image/ColorSpace/HSI.hs b/src/Graphics/Image/ColorSpace/HSI.hs
--- a/src/Graphics/Image/ColorSpace/HSI.hs
+++ b/src/Graphics/Image/ColorSpace/HSI.hs
@@ -2,10 +2,12 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
 -- |
 -- Module      : Graphics.Image.ColorSpace.HSI
--- Copyright   : (c) Alexey Kuleshevich 2016
+-- Copyright   : (c) Alexey Kuleshevich 2017
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -17,18 +19,152 @@
   ) where
 
 import Prelude hiding (map)
-import Graphics.Image.Interface
+import Control.Applicative
+import Data.Foldable
 import Data.Typeable (Typeable)
-import qualified Data.Monoid as M (mappend)
-import qualified Data.Colour as C
-import qualified Data.Colour.Names as C
+import Foreign.Ptr
+import Foreign.Storable
 
+import Graphics.Image.Interface
+
+-----------
+--- HSI ---
+-----------
+
 -- | Hue, Saturation and Intensity color space.
 data HSI = HueHSI -- ^ Hue
          | SatHSI -- ^ Saturation 
          | IntHSI -- ^ Intensity
          deriving (Eq, Enum, Typeable)
 
+data instance Pixel HSI e = PixelHSI !e !e !e deriving Eq
+
+
+instance Show HSI where
+  show HueHSI = "Hue"
+  show SatHSI = "Saturation"
+  show IntHSI = "Intensity"
+  
+instance Show e => Show (Pixel HSI e) where
+  show (PixelHSI h s i) = "<HSI:("++show h++"|"++show s++"|"++show i++")>"
+
+
+instance (Elevator e, Typeable e) => ColorSpace HSI e where
+  type Components HSI e = (e, e, e)
+
+  toComponents (PixelHSI h s i) = (h, s, i)
+  {-# INLINE toComponents #-}
+  fromComponents !(h, s, i) = PixelHSI h s i
+  {-# INLINE fromComponents #-}
+  broadcastC = pure
+  {-# INLINE broadcastC #-}
+  getPxC (PixelHSI h _ _) HueHSI = h
+  getPxC (PixelHSI _ s _) SatHSI = s
+  getPxC (PixelHSI _ _ i) IntHSI = i
+  {-# INLINE getPxC #-}
+  setPxC (PixelHSI _ s i) HueHSI h = PixelHSI h s i
+  setPxC (PixelHSI h _ i) SatHSI s = PixelHSI h s i
+  setPxC (PixelHSI h s _) IntHSI i = PixelHSI h s i
+  {-# INLINE setPxC #-}
+  mapPxC f (PixelHSI h s i) = PixelHSI (f HueHSI h) (f SatHSI s) (f IntHSI i)
+  {-# INLINE mapPxC #-}
+  mapPx = fmap
+  {-# INLINE mapPx #-}
+  zipWithPx = liftA2
+  {-# INLINE zipWithPx #-}
+  foldlPx = foldl'
+  {-# INLINE foldlPx #-}
+
+
+instance Functor (Pixel HSI) where
+  fmap f (PixelHSI h s i) = PixelHSI (f h) (f s) (f i)
+  {-# INLINE fmap #-}
+
+
+instance Applicative (Pixel HSI) where
+  pure !e = PixelHSI e e e
+  {-# INLINE pure #-}
+  (PixelHSI fh fs fi) <*> (PixelHSI h s i) = PixelHSI (fh h) (fs s) (fi i)
+  {-# INLINE (<*>) #-}
+
+
+instance Foldable (Pixel HSI) where
+  foldr f !z (PixelHSI h s i) = f h (f s (f i z))
+  {-# INLINE foldr #-}
+
+instance Num e => Num (Pixel HSI e) where
+  (+)         = liftA2 (+)
+  {-# INLINE (+) #-}
+  (-)         = liftA2 (-)
+  {-# INLINE (-) #-}
+  (*)         = liftA2 (*)
+  {-# INLINE (*) #-}
+  abs         = liftA abs
+  {-# INLINE abs #-}
+  signum      = liftA signum
+  {-# INLINE signum #-}
+  fromInteger = pure . fromInteger
+  {-# INLINE fromInteger #-}
+  
+
+instance Fractional e => Fractional (Pixel HSI e) where
+  (/)          = liftA2 (/)
+  {-# INLINE (/) #-}
+  recip        = liftA recip
+  {-# INLINE recip #-}
+  fromRational = pure . fromRational
+  {-# INLINE fromRational #-}
+
+
+instance Floating e => Floating (Pixel HSI e) where
+  pi      = pure pi
+  {-# INLINE pi #-}
+  exp     = liftA exp
+  {-# INLINE exp #-}
+  log     = liftA log
+  {-# INLINE log #-}
+  sin     = liftA sin
+  {-# INLINE sin #-}
+  cos     = liftA cos
+  {-# INLINE cos #-}
+  asin    = liftA asin
+  {-# INLINE asin #-}
+  atan    = liftA atan
+  {-# INLINE atan #-}
+  acos    = liftA acos
+  {-# INLINE acos #-}
+  sinh    = liftA sinh
+  {-# INLINE sinh #-}
+  cosh    = liftA cosh
+  {-# INLINE cosh #-}
+  asinh   = liftA asinh
+  {-# INLINE asinh #-}
+  atanh   = liftA atanh
+  {-# INLINE atanh #-}
+  acosh   = liftA acosh
+  {-# INLINE acosh #-}
+
+
+instance Storable e => Storable (Pixel HSI e) where
+
+  sizeOf _ = 3 * sizeOf (undefined :: e)
+  alignment _ = alignment (undefined :: e)
+  peek p = do
+    q <- return $ castPtr p
+    r <- peek q
+    g <- peekElemOff q 1
+    b <- peekElemOff q 2
+    return (PixelHSI r g b)
+  poke p (PixelHSI r g b) = do
+    q <- return $ castPtr p
+    poke q r
+    pokeElemOff q 1 g
+    pokeElemOff q 2 b
+
+------------
+--- HSIA ---
+------------
+
 -- | Hue, Saturation and Intensity color space with Alpha channel.
 data HSIA = HueHSIA   -- ^ Hue
           | SatHSIA   -- ^ Saturation
@@ -37,8 +173,11 @@
           deriving (Eq, Enum, Typeable)
 
 
+data instance Pixel HSIA e = PixelHSIA !e !e !e !e deriving Eq
+
+
 -- | Conversion to `HSI` color space.
-class ColorSpace cs => ToHSI cs where
+class ColorSpace cs Double => ToHSI cs where
 
   -- | Convert to an `HSI` pixel.
   toPixelHSI :: Pixel cs Double -> Pixel HSI Double
@@ -49,10 +188,63 @@
              -> Image arr HSI Double
   toImageHSI = map toPixelHSI
   {-# INLINE toImageHSI #-}
+
+
+
+instance Show HSIA where
+  show HueHSIA   = "Hue"
+  show SatHSIA   = "Saturation"
+  show IntHSIA   = "Intensity"
+  show AlphaHSIA = "Alpha"
+
   
+instance Show e => Show (Pixel HSIA e) where
+  show (PixelHSIA h s i a) = "<HSIA:("++show h++"|"++show s++"|"++show i++"|"++show a++")>"
 
+
+instance (Elevator e, Typeable e) => ColorSpace HSIA e where
+  type Components HSIA e = (e, e, e, e)
+
+  toComponents (PixelHSIA h s i a) = (h, s, i, a)
+  {-# INLINE toComponents #-}
+  fromComponents !(h, s, i, a) = PixelHSIA h s i a
+  {-# INLINE fromComponents #-}
+  broadcastC = pure
+  {-# INLINE broadcastC #-}
+  getPxC (PixelHSIA h _ _ _) HueHSIA   = h
+  getPxC (PixelHSIA _ s _ _) SatHSIA   = s
+  getPxC (PixelHSIA _ _ i _) IntHSIA   = i
+  getPxC (PixelHSIA _ _ _ a) AlphaHSIA = a
+  {-# INLINE getPxC #-}
+  setPxC (PixelHSIA _ s i a) HueHSIA h   = PixelHSIA h s i a
+  setPxC (PixelHSIA h _ i a) SatHSIA s   = PixelHSIA h s i a
+  setPxC (PixelHSIA h s _ a) IntHSIA i   = PixelHSIA h s i a
+  setPxC (PixelHSIA h s i _) AlphaHSIA a = PixelHSIA h s i a
+  {-# INLINE setPxC #-}
+  mapPxC f (PixelHSIA h s i a) =
+    PixelHSIA (f HueHSIA h) (f SatHSIA s) (f IntHSIA i) (f AlphaHSIA a)
+  {-# INLINE mapPxC #-}
+  mapPx = fmap
+  {-# INLINE mapPx #-}
+  zipWithPx = liftA2
+  {-# INLINE zipWithPx #-}
+  foldlPx = foldl'
+  {-# INLINE foldlPx #-}
+
+
+instance (Elevator e, Typeable e) => AlphaSpace HSIA e where
+  type Opaque HSIA = HSI
+
+  getAlpha (PixelHSIA _ _ _ a) = a
+  {-# INLINE getAlpha #-}
+  addAlpha !a (PixelHSI h s i) = PixelHSIA h s i a
+  {-# INLINE addAlpha #-}
+  dropAlpha (PixelHSIA h s i _) = PixelHSI h s i
+  {-# INLINE dropAlpha #-}
+
+
 -- | Conversion to `HSIA` from another color space with Alpha channel.
-class (ToHSI (Opaque cs), Alpha cs) => ToHSIA cs where
+class (ToHSI (Opaque cs), AlphaSpace cs Double) => ToHSIA cs where
 
   -- | Convert to an `HSIA` pixel.
   toPixelHSIA :: Pixel cs Double -> Pixel HSIA Double
@@ -66,114 +258,91 @@
   toImageHSIA = map toPixelHSIA
   {-# INLINE toImageHSIA #-}
 
-  
-instance ColorSpace HSI where
-  type PixelElt HSI e = (e, e, e)
-  data Pixel HSI e = PixelHSI !e !e !e deriving Eq
 
-  fromChannel !e = PixelHSI e e e
-  {-# INLINE fromChannel #-}
+instance Functor (Pixel HSIA) where
+  fmap f (PixelHSIA h s i a) = PixelHSIA (f h) (f s) (f i) (f a)
+  {-# INLINE fmap #-}
 
-  fromElt !(h, s, i) = PixelHSI h s i
-  {-# INLINE fromElt #-}
 
-  toElt (PixelHSI h s i) = (h, s, i)
-  {-# INLINE toElt #-}
+instance Applicative (Pixel HSIA) where
+  pure !e = PixelHSIA e e e e
+  {-# INLINE pure #-}
+  (PixelHSIA fh fs fi fa) <*> (PixelHSIA h s i a) = PixelHSIA (fh h) (fs s) (fi i) (fa a)
+  {-# INLINE (<*>) #-}
 
-  getPxCh (PixelHSI h _ _) HueHSI   = h
-  getPxCh (PixelHSI _ s _) SatHSI = s
-  getPxCh (PixelHSI _ _ i) IntHSI  = i
-  {-# INLINE getPxCh #-}
-  
-  chOp !f (PixelHSI h s i) = PixelHSI (f HueHSI h) (f SatHSI s) (f IntHSI i)
-  {-# INLINE chOp #-}
 
-  pxOp !f (PixelHSI h s i) = PixelHSI (f h) (f s) (f i)
-  {-# INLINE pxOp #-}
-
-  chApp (PixelHSI fh fs fi) (PixelHSI h s i) = PixelHSI (fh h) (fs s) (fi i)
-  {-# INLINE chApp #-}
-
-  pxFoldMap f (PixelHSI h s i) = f h `M.mappend` f s `M.mappend` f i 
-  {-# INLINE pxFoldMap #-}
-
-  csColour HueHSI = C.opaque C.purple
-  csColour SatHSI = C.opaque C.orange
-  csColour IntHSI = C.opaque C.darkblue
-
+instance Foldable (Pixel HSIA) where
+  foldr f !z (PixelHSIA h s i a) = f h (f s (f i (f a z)))
+  {-# INLINE foldr #-}
 
 
-instance ColorSpace HSIA where
-  type PixelElt HSIA e = (e, e, e, e)
-  data Pixel HSIA e = PixelHSIA !e !e !e !e deriving Eq
-
-  fromChannel !e = PixelHSIA e e e e
-  {-# INLINE fromChannel #-}
-
-  fromElt (h, s, i, a) = PixelHSIA h s i a
-  {-# INLINE fromElt #-}
-
-  toElt (PixelHSIA h s i a) = (h, s, i, a)
-  {-# INLINE toElt #-}
-
-  getPxCh (PixelHSIA r _ _ _) HueHSIA   = r
-  getPxCh (PixelHSIA _ g _ _) SatHSIA = g
-  getPxCh (PixelHSIA _ _ b _) IntHSIA  = b
-  getPxCh (PixelHSIA _ _ _ a) AlphaHSIA = a
-  {-# INLINE getPxCh #-}
-  
-  chOp !f (PixelHSIA h s i a) =
-    PixelHSIA (f HueHSIA h) (f SatHSIA s) (f IntHSIA i) (f AlphaHSIA a)
-  {-# INLINE chOp #-}
-
-  pxOp !f (PixelHSIA h s i a) = PixelHSIA (f h) (f s) (f i) (f a)
-  {-# INLINE pxOp #-}
-
-  chApp (PixelHSIA fh fs fi fa) (PixelHSIA h s i a) = PixelHSIA (fh h) (fs s) (fi i) (fa a)
-  {-# INLINE chApp #-}
-
-  pxFoldMap f (PixelHSIA h s i a) = f h `M.mappend` f s `M.mappend` f i `M.mappend` f a
-  {-# INLINE pxFoldMap #-}
-
-  csColour AlphaHSIA = C.opaque C.gray
-  csColour ch        = csColour $ opaque ch
-  
-
-instance Alpha HSIA where
-  type Opaque HSIA = HSI
-
-  getAlpha (PixelHSIA _ _ _ a) = a
-  {-# INLINE getAlpha #-}
-  
-  addAlpha !a (PixelHSI h s i) = PixelHSIA h s i a
-  {-# INLINE addAlpha #-}
-
-  dropAlpha (PixelHSIA h s i _) = PixelHSI h s i
-  {-# INLINE dropAlpha #-}
-
-  opaque HueHSIA = HueHSI
-  opaque SatHSIA = SatHSI
-  opaque IntHSIA = IntHSI
-  opaque _       = error "Data.Image.ColorSpace.HSI (Alpha.opaque)"
+instance Num e => Num (Pixel HSIA e) where
+  (+)         = liftA2 (+)
+  {-# INLINE (+) #-}
+  (-)         = liftA2 (-)
+  {-# INLINE (-) #-}
+  (*)         = liftA2 (*)
+  {-# INLINE (*) #-}
+  abs         = liftA abs
+  {-# INLINE abs #-}
+  signum      = liftA signum
+  {-# INLINE signum #-}
+  fromInteger = pure . fromInteger
+  {-# INLINE fromInteger #-}
 
 
-instance Show HSI where
-  show HueHSI = "Hue"
-  show SatHSI = "Saturation"
-  show IntHSI = "Intensity"
-  
-
-instance Show HSIA where
-  show AlphaHSIA = "Alpha"
-  show ch        = show $ opaque ch
-
-  
-instance Show e => Show (Pixel HSI e) where
-  show (PixelHSI h s i) = "<HSI:("++show h++"|"++show s++"|"++show i++")>"
+instance Fractional e => Fractional (Pixel HSIA e) where
+  (/)          = liftA2 (/)
+  {-# INLINE (/) #-}
+  recip        = liftA recip
+  {-# INLINE recip #-}
+  fromRational = pure . fromRational
+  {-# INLINE fromRational #-}
 
 
-instance Show e => Show (Pixel HSIA e) where
-  show (PixelHSIA h s i a) = "<HSIA:("++show h++"|"++show s++"|"++show i++"|"++show a++")>"
+instance Floating e => Floating (Pixel HSIA e) where
+  pi      = pure pi
+  {-# INLINE pi #-}
+  exp     = liftA exp
+  {-# INLINE exp #-}
+  log     = liftA log
+  {-# INLINE log #-}
+  sin     = liftA sin
+  {-# INLINE sin #-}
+  cos     = liftA cos
+  {-# INLINE cos #-}
+  asin    = liftA asin
+  {-# INLINE asin #-}
+  atan    = liftA atan
+  {-# INLINE atan #-}
+  acos    = liftA acos
+  {-# INLINE acos #-}
+  sinh    = liftA sinh
+  {-# INLINE sinh #-}
+  cosh    = liftA cosh
+  {-# INLINE cosh #-}
+  asinh   = liftA asinh
+  {-# INLINE asinh #-}
+  atanh   = liftA atanh
+  {-# INLINE atanh #-}
+  acosh   = liftA acosh
+  {-# INLINE acosh #-}
 
 
+instance Storable e => Storable (Pixel HSIA e) where
 
+  sizeOf _ = 3 * sizeOf (undefined :: e)
+  alignment _ = alignment (undefined :: e)
+  peek p = do
+    q <- return $ castPtr p
+    h <- peek q
+    s <- peekElemOff q 1
+    i <- peekElemOff q 2
+    a <- peekElemOff q 3
+    return (PixelHSIA h s i a)
+  poke p (PixelHSIA h s i a) = do
+    q <- return $ castPtr p
+    poke q h
+    pokeElemOff q 1 s
+    pokeElemOff q 2 i
+    pokeElemOff q 3 a
diff --git a/src/Graphics/Image/ColorSpace/Luma.hs b/src/Graphics/Image/ColorSpace/Luma.hs
--- a/src/Graphics/Image/ColorSpace/Luma.hs
+++ b/src/Graphics/Image/ColorSpace/Luma.hs
@@ -2,6 +2,8 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
 -- |
 -- Module      : Graphics.Image.ColorSpace.Luma
@@ -17,24 +19,26 @@
   ) where
 
 import Prelude hiding (map)
-import Graphics.Image.Interface
+import Control.Applicative
+import Data.Foldable
 import Data.Typeable (Typeable)
-import qualified Data.Monoid as M (mappend, mempty)
-import qualified Data.Colour as C
-import qualified Data.Colour.Names as C
+import Foreign.Ptr
+import Foreign.Storable
 
--- | Luma or brightness, that is usually denoted as @Y'@.
-data Y = Y deriving (Eq, Enum, Typeable)
+import Graphics.Image.Interface
 
+---------
+--- Y ---
+---------
 
--- | Luma with Alpha channel.
-data YA = YA      -- ^ Luma
-        | AlphaYA -- ^ Alpha channel
-        deriving (Eq, Enum, Typeable)
+-- | Luma or brightness, which is usually denoted as @Y'@.
+data Y = LumaY deriving (Eq, Enum, Typeable)
 
 
+data instance Pixel Y e = PixelY !e deriving (Ord, Eq)
+
 -- | Conversion to Luma color space.
-class ColorSpace cs => ToY cs where
+class ColorSpace cs Double => ToY cs where
 
   -- | Convert a pixel to Luma pixel.
   toPixelY :: Pixel cs Double -> Pixel Y Double
@@ -46,124 +50,279 @@
   toImageY = map toPixelY
   {-# INLINE toImageY #-}
 
-  
--- | Conversion to Luma from another color space with Alpha channel.
-class (ToY (Opaque cs), Alpha cs) => ToYA cs where
+instance Show Y where
+  show LumaY = "Luma"
 
-  -- | Convert a pixel to Luma pixel with Alpha.
-  toPixelYA :: Pixel cs Double -> Pixel YA Double
-  toPixelYA px = addAlpha (getAlpha px) (toPixelY (dropAlpha px))
-  {-# INLINE toPixelYA #-}
+instance Show e => Show (Pixel Y e) where
+  show (PixelY g) = "<Luma:("++show g++")>"
 
-  -- | Convert an image to Luma image with Alpha.
-  toImageYA :: (Array arr cs Double, Array arr YA Double) =>
-               Image arr cs Double
-            -> Image arr YA Double
-  toImageYA = map toPixelYA
-  {-# INLINE toImageYA #-}
+instance (Elevator e, Typeable e) => ColorSpace Y e where
+  type Components Y e = e
+  broadcastC = PixelY
+  {-# INLINE broadcastC #-}
+  fromComponents = PixelY
+  {-# INLINE fromComponents #-}
+  toComponents (PixelY y) = y
+  {-# INLINE toComponents #-}
+  getPxC (PixelY y) LumaY = y
+  {-# INLINE getPxC #-}
+  setPxC _ LumaY y = PixelY y
+  {-# INLINE setPxC #-}
+  mapPxC f (PixelY y) = PixelY (f LumaY y)
+  {-# INLINE mapPxC #-}
+  mapPx = fmap
+  {-# INLINE mapPx #-}
+  zipWithPx = liftA2
+  {-# INLINE zipWithPx #-}
+  foldlPx = foldl'
+  {-# INLINE foldlPx #-}
 
 
-instance ColorSpace Y where
-  type PixelElt Y e = e
-  data Pixel Y e = PixelY !e deriving (Ord, Eq)
+instance Functor (Pixel Y) where
+  fmap f (PixelY y) = PixelY (f y)
+  {-# INLINE fmap #-}
 
-  fromChannel = PixelY
-  {-# INLINE fromChannel #-}
 
-  fromElt = PixelY
-  {-# INLINE fromElt #-}
+instance Applicative (Pixel Y) where
+  pure = PixelY
+  {-# INLINE pure #-}
+  (PixelY fy) <*> (PixelY y) = PixelY (fy y)
+  {-# INLINE (<*>) #-}
 
-  toElt (PixelY y) = y
-  {-# INLINE toElt #-}
 
-  getPxCh (PixelY y) _ = y
-  {-# INLINE getPxCh #-}
-  
-  chOp !f (PixelY y) = PixelY (f Y y)
-  {-# INLINE chOp #-}
- 
-  pxOp !f (PixelY y) = PixelY (f y)
-  {-# INLINE pxOp #-}
+instance Foldable (Pixel Y) where
+  foldr f !z (PixelY y) = f y z
+  {-# INLINE foldr #-}
 
-  chApp (PixelY fy) (PixelY y) = PixelY (fy y)
-  {-# INLINE chApp #-}
 
-  pxFoldMap f (PixelY y) = f y `M.mappend` M.mempty
-  {-# INLINE pxFoldMap #-}
+instance Monad (Pixel Y) where
 
-  csColour _ = C.opaque C.darkgray
+  return = PixelY
+  {-# INLINE return #-}
+
+  (>>=) (PixelY y) f = f y
+  {-# INLINE (>>=) #-}
+
+
+instance Num e => Num (Pixel Y e) where
+  (+)         = liftA2 (+)
+  {-# INLINE (+) #-}
+  (-)         = liftA2 (-)
+  {-# INLINE (-) #-}
+  (*)         = liftA2 (*)
+  {-# INLINE (*) #-}
+  abs         = liftA abs
+  {-# INLINE abs #-}
+  signum      = liftA signum
+  {-# INLINE signum #-}
+  fromInteger = pure . fromInteger
+  {-# INLINE fromInteger #-}
   
 
-instance ColorSpace YA where
-  type PixelElt YA e = (e, e)
-  data Pixel YA e = PixelYA !e !e deriving Eq
+instance Fractional e => Fractional (Pixel Y e) where
+  (/)          = liftA2 (/)
+  {-# INLINE (/) #-}
+  recip        = liftA recip
+  {-# INLINE recip #-}
+  fromRational = pure . fromRational
+  {-# INLINE fromRational #-}
 
-  fromChannel !e = PixelYA e e 
-  {-# INLINE fromChannel #-}
 
-  fromElt !(g, a) = PixelYA g a
-  {-# INLINE fromElt #-}
+instance Floating e => Floating (Pixel Y e) where
+  pi      = pure pi
+  {-# INLINE pi #-}
+  exp     = liftA exp
+  {-# INLINE exp #-}
+  log     = liftA log
+  {-# INLINE log #-}
+  sin     = liftA sin
+  {-# INLINE sin #-}
+  cos     = liftA cos
+  {-# INLINE cos #-}
+  asin    = liftA asin
+  {-# INLINE asin #-}
+  atan    = liftA atan
+  {-# INLINE atan #-}
+  acos    = liftA acos
+  {-# INLINE acos #-}
+  sinh    = liftA sinh
+  {-# INLINE sinh #-}
+  cosh    = liftA cosh
+  {-# INLINE cosh #-}
+  asinh   = liftA asinh
+  {-# INLINE asinh #-}
+  atanh   = liftA atanh
+  {-# INLINE atanh #-}
+  acosh   = liftA acosh
+  {-# INLINE acosh #-}
 
-  toElt (PixelYA g a) = (g, a)
-  {-# INLINE toElt  #-}
 
-  getPxCh (PixelYA g _) YA      = g
-  getPxCh (PixelYA _ a) AlphaYA = a
-  {-# INLINE getPxCh  #-}
-  
-  chOp !f (PixelYA g a) = PixelYA (f YA g) (f AlphaYA a)
-  {-# INLINE chOp #-}
-  
-  pxOp !f (PixelYA g a) = PixelYA (f g) (f a)
-  {-# INLINE pxOp #-}
+instance Storable e => Storable (Pixel Y e) where
 
-  chApp (PixelYA fy fa) (PixelYA y a) = PixelYA (fy y) (fa a)
-  {-# INLINE chApp #-}
+  sizeOf _ = sizeOf (undefined :: e)
+  alignment _ = alignment (undefined :: e)
+  peek p = do
+    q <- return $ castPtr p
+    y <- peek q
+    return (PixelY y)
+  poke p (PixelY y) = do
+    q <- return $ castPtr p
+    poke q y
 
-  pxFoldMap f (PixelYA y a) = f y `M.mappend` f a
-  {-# INLINE pxFoldMap #-}
 
-  csColour AlphaYA = C.opaque C.gray
-  csColour ch      = csColour $ opaque ch
+
+
+----------
+--- YA ---
+----------
+
+-- | Luma with Alpha channel.
+data YA = LumaYA  -- ^ Luma
+        | AlphaYA -- ^ Alpha channel
+        deriving (Eq, Enum, Typeable)
+
+data instance Pixel YA e = PixelYA !e !e deriving Eq
+
+-- | Conversion to Luma from another color space with Alpha channel.
+class (ToY (Opaque cs), AlphaSpace cs Double) => ToYA cs where
+
+  -- | Convert a pixel to Luma pixel with Alpha.
+  toPixelYA :: Pixel cs Double -> Pixel YA Double
+  toPixelYA px = addAlpha (getAlpha px) (toPixelY (dropAlpha px))
+  {-# INLINE toPixelYA #-}
+
+  -- | Convert an image to Luma image with Alpha.
+  toImageYA :: (Array arr cs Double, Array arr YA Double) =>
+               Image arr cs Double
+            -> Image arr YA Double
+  toImageYA = map toPixelYA
+  {-# INLINE toImageYA #-}
+
+
+instance Show YA where
+  show LumaYA  = "Luma"
+  show AlphaYA = "Alpha"
+
+instance (Elevator e, Typeable e) => ColorSpace YA e where
+  type Components YA e = (e, e)
+  broadcastC e = PixelYA e e
+  {-# INLINE broadcastC #-}
+  fromComponents (y, a) = PixelYA y a
+  {-# INLINE fromComponents #-}
+  toComponents (PixelYA y a) = (y, a)
+  {-# INLINE toComponents #-}
+  getPxC (PixelYA y _)  LumaYA = y
+  getPxC (PixelYA _ a) AlphaYA = a
+  {-# INLINE getPxC #-}
+  setPxC (PixelYA _ a) LumaYA  y = PixelYA y a
+  setPxC (PixelYA y _) AlphaYA a = PixelYA y a
+  {-# INLINE setPxC #-}
+  mapPxC f (PixelYA y a) = PixelYA (f LumaYA y) (f AlphaYA a)
+  {-# INLINE mapPxC #-}
+  mapPx = fmap
+  {-# INLINE mapPx #-}
+  zipWithPx = liftA2
+  {-# INLINE zipWithPx #-}
+  foldlPx = foldl'
+  {-# INLINE foldlPx #-}
   
   
-instance Alpha YA where
+instance (Elevator e, Typeable e) => AlphaSpace YA e where
   type Opaque YA = Y
 
   getAlpha (PixelYA _ a) = a
   {-# INLINE getAlpha  #-}
-  
-  addAlpha !a (PixelY g) = PixelYA g a
+  addAlpha !a (PixelY y) = PixelYA y a
   {-# INLINE addAlpha #-}
-
-  dropAlpha (PixelYA g _) = PixelY g
+  dropAlpha (PixelYA y _) = PixelY y
   {-# INLINE dropAlpha #-}
 
-  opaque YA = Y
-  opaque _  = error "Data.Image.ColorSpace.Luma (Alpha.opaque)"
+  
+instance Functor (Pixel YA) where
+  fmap f (PixelYA y a) = PixelYA (f y) (f a)
+  {-# INLINE fmap #-}
 
 
-instance Show Y where
-  show Y = "Luma"
-  
+instance Applicative (Pixel YA) where
+  pure !e = PixelYA e e
+  {-# INLINE pure #-}
+  (PixelYA fy fa) <*> (PixelYA y a) = PixelYA (fy y) (fa a)
+  {-# INLINE (<*>) #-}
 
-instance Show YA where
-  show AlphaYA = "Alpha"
-  show ch      = show $ opaque ch
+
+instance Foldable (Pixel YA) where
+  foldr f !z (PixelYA y a) = f y (f a z)
+  {-# INLINE foldr #-}
+
+
+instance Num e => Num (Pixel YA e) where
+  (+)         = liftA2 (+)
+  {-# INLINE (+) #-}
   
+  (-)         = liftA2 (-)
+  {-# INLINE (-) #-}
+  
+  (*)         = liftA2 (*)
+  {-# INLINE (*) #-}
+  
+  abs         = liftA abs
+  {-# INLINE abs #-}
+  
+  signum      = liftA signum
+  {-# INLINE signum #-}
+  
+  fromInteger = pure . fromInteger
+  {-# INLINE fromInteger #-}
 
-instance Show e => Show (Pixel Y e) where
-  show (PixelY g) = "<Luma:("++show g++")>"
+instance Fractional e => Fractional (Pixel YA e) where
+  (/)          = liftA2 (/)
+  {-# INLINE (/) #-}
+  recip        = liftA recip
+  {-# INLINE recip #-}
+  fromRational = pure . fromRational
+  {-# INLINE fromRational #-}
 
 
-instance Show e => Show (Pixel YA e) where
-  show (PixelYA g a) = "<LumaA:("++show g++"|"++show a++")>"
+instance Floating e => Floating (Pixel YA e) where
+  pi      = pure pi
+  {-# INLINE pi #-}
+  exp     = liftA exp
+  {-# INLINE exp #-}
+  log     = liftA log
+  {-# INLINE log #-}
+  sin     = liftA sin
+  {-# INLINE sin #-}
+  cos     = liftA cos
+  {-# INLINE cos #-}
+  asin    = liftA asin
+  {-# INLINE asin #-}
+  atan    = liftA atan
+  {-# INLINE atan #-}
+  acos    = liftA acos
+  {-# INLINE acos #-}
+  sinh    = liftA sinh
+  {-# INLINE sinh #-}
+  cosh    = liftA cosh
+  {-# INLINE cosh #-}
+  asinh   = liftA asinh
+  {-# INLINE asinh #-}
+  atanh   = liftA atanh
+  {-# INLINE atanh #-}
+  acosh   = liftA acosh
+  {-# INLINE acosh #-}
 
 
-instance Monad (Pixel Y) where
+instance Storable e => Storable (Pixel YA e) where
 
-  return = PixelY
-  {-# INLINE return #-}
+  sizeOf _ = 2 * sizeOf (undefined :: e)
+  alignment _ = alignment (undefined :: e)
+  peek p = do
+    q <- return $ castPtr p
+    y <- peekElemOff q 0
+    a <- peekElemOff q 1
+    return (PixelYA y a)
+  poke p (PixelYA y a) = do
+    q <- return $ castPtr p
+    pokeElemOff q 0 y
+    pokeElemOff q 1 a
 
-  (>>=) (PixelY y) f = f y
-  {-# INLINE (>>=) #-}
diff --git a/src/Graphics/Image/ColorSpace/RGB.hs b/src/Graphics/Image/ColorSpace/RGB.hs
--- a/src/Graphics/Image/ColorSpace/RGB.hs
+++ b/src/Graphics/Image/ColorSpace/RGB.hs
@@ -2,42 +2,55 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
 -- |
 -- Module      : Graphics.Image.ColorSpace.RGB
--- Copyright   : (c) Alexey Kuleshevich 2016
+-- Copyright   : (c) Alexey Kuleshevich 2017
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
 -- Portability : non-portable
 --
 module Graphics.Image.ColorSpace.RGB (
-  RGB(..), RGBA(..), Pixel(..), 
-  ToRGB(..), ToRGBA(..)
+  RGB(..), RGBA(..), Pixel(..),
+  ToRGB(..), ToRGBA(..),
+  -- RGB16 -- Experimental  
   ) where
 
 import Prelude hiding (map)
-import Graphics.Image.Interface
+import Control.Applicative
+import Foreign.Ptr
+import Foreign.Storable
+import Data.Foldable
 import Data.Typeable (Typeable)
-import qualified Data.Monoid as M (mappend)
-import qualified Data.Colour as C
-import qualified Data.Colour.Names as C
 
+import Graphics.Image.Interface
 
+-----------
+--- RGB ---
+-----------
+
 -- | Red, Green and Blue color space.
 data RGB = RedRGB
          | GreenRGB
          | BlueRGB deriving (Eq, Enum, Typeable)
 
--- | Red, Green and Blue color space with Alpha channel.
-data RGBA = RedRGBA
-          | GreenRGBA
-          | BlueRGBA
-          | AlphaRGBA deriving (Eq, Enum, Typeable)
+instance Show RGB where
+  show RedRGB   = "Red"
+  show GreenRGB = "Green"
+  show BlueRGB  = "Blue"
 
 
+data instance Pixel RGB e = PixelRGB !e !e !e deriving Eq
+
+instance Show e => Show (Pixel RGB e) where
+  show (PixelRGB r g b) = "<RGB:("++show r++"|"++show g++"|"++show b++")>"
+
+
 -- | Conversion to `RGB` color space.
-class ColorSpace cs => ToRGB cs where
+class ColorSpace cs Double => ToRGB cs where
 
   -- | Convert to an `RGB` pixel.
   toPixelRGB :: Pixel cs Double -> Pixel RGB Double
@@ -50,8 +63,159 @@
   {-# INLINE toImageRGB #-}
 
 
+
+instance (Elevator e, Typeable e) => ColorSpace RGB e where
+  type Components RGB e = (e, e, e)
+
+  toComponents (PixelRGB r g b) = (r, g, b)
+  {-# INLINE toComponents #-}
+  
+  fromComponents !(r, g, b) = PixelRGB r g b
+  {-# INLINE fromComponents #-}
+
+  broadcastC = pure
+  {-# INLINE broadcastC #-}
+
+  getPxC (PixelRGB r _ _) RedRGB   = r
+  getPxC (PixelRGB _ g _) GreenRGB = g
+  getPxC (PixelRGB _ _ b) BlueRGB  = b
+  {-# INLINE getPxC #-}
+
+  setPxC (PixelRGB _ g b) RedRGB   r = PixelRGB r g b
+  setPxC (PixelRGB r _ b) GreenRGB g = PixelRGB r g b
+  setPxC (PixelRGB r g _) BlueRGB  b = PixelRGB r g b
+  {-# INLINE setPxC #-}
+
+  mapPxC f (PixelRGB r g b) = PixelRGB (f RedRGB r) (f GreenRGB g) (f BlueRGB b)
+  {-# INLINE mapPxC #-}
+
+  mapPx = fmap
+  {-# INLINE mapPx #-}
+
+  zipWithPx = liftA2
+  {-# INLINE zipWithPx #-}
+
+  foldlPx = foldl'
+  {-# INLINE foldlPx #-}
+
+
+
+
+instance Functor (Pixel RGB) where
+  fmap f (PixelRGB r g b) = PixelRGB (f r) (f g) (f b)
+  {-# INLINE fmap #-}
+
+
+instance Applicative (Pixel RGB) where
+  pure !e = PixelRGB e e e
+  {-# INLINE pure #-}
+  (PixelRGB fr fg fb) <*> (PixelRGB r g b) = PixelRGB (fr r) (fg g) (fb b)
+  {-# INLINE (<*>) #-}
+
+
+instance Foldable (Pixel RGB) where
+  foldr f !z (PixelRGB r g b) = f r (f g (f b z))
+  {-# INLINE foldr #-}
+
+
+instance Num e => Num (Pixel RGB e) where
+  (+)         = liftA2 (+)
+  {-# INLINE (+) #-}
+  (-)         = liftA2 (-)
+  {-# INLINE (-) #-}
+  (*)         = liftA2 (*)
+  {-# INLINE (*) #-}
+  abs         = liftA abs
+  {-# INLINE abs #-}
+  signum      = liftA signum
+  {-# INLINE signum #-}
+  fromInteger = pure . fromInteger
+  {-# INLINE fromInteger #-}
+  
+
+instance Fractional e => Fractional (Pixel RGB e) where
+  (/)          = liftA2 (/)
+  {-# INLINE (/) #-}
+  recip        = liftA recip
+  {-# INLINE recip #-}
+  fromRational = pure . fromRational
+  {-# INLINE fromRational #-}
+
+
+instance Floating e => Floating (Pixel RGB e) where
+  pi      = pure pi
+  {-# INLINE pi #-}
+  exp     = liftA exp
+  {-# INLINE exp #-}
+  log     = liftA log
+  {-# INLINE log #-}
+  sin     = liftA sin
+  {-# INLINE sin #-}
+  cos     = liftA cos
+  {-# INLINE cos #-}
+  asin    = liftA asin
+  {-# INLINE asin #-}
+  atan    = liftA atan
+  {-# INLINE atan #-}
+  acos    = liftA acos
+  {-# INLINE acos #-}
+  sinh    = liftA sinh
+  {-# INLINE sinh #-}
+  cosh    = liftA cosh
+  {-# INLINE cosh #-}
+  asinh   = liftA asinh
+  {-# INLINE asinh #-}
+  atanh   = liftA atanh
+  {-# INLINE atanh #-}
+  acosh   = liftA acosh
+  {-# INLINE acosh #-}
+
+
+instance Storable e => Storable (Pixel RGB e) where
+
+  sizeOf _ = 3 * sizeOf (undefined :: e)
+  alignment _ = alignment (undefined :: e)
+  peek p = do
+    q <- return $ castPtr p
+    r <- peek q
+    g <- peekElemOff q 1
+    b <- peekElemOff q 2
+    return (PixelRGB r g b)
+  poke p (PixelRGB r g b) = do
+    q <- return $ castPtr p
+    poke q r
+    pokeElemOff q 1 g
+    pokeElemOff q 2 b
+
+
+
+
+------------
+--- RGBA ---
+------------
+
+
+-- | Red, Green and Blue color space with Alpha channel.
+data RGBA = RedRGBA
+          | GreenRGBA
+          | BlueRGBA
+          | AlphaRGBA deriving (Eq, Enum, Typeable)
+
+instance Show RGBA where
+  show RedRGBA   = "Red"
+  show GreenRGBA = "Green"
+  show BlueRGBA  = "Blue"
+  show AlphaRGBA = "Alpha"
+
+data instance Pixel RGBA e = PixelRGBA !e !e !e !e deriving Eq
+
+
+instance Show e => Show (Pixel RGBA e) where
+  show (PixelRGBA r g b a) = "<RGBA:("++show r++"|"++show g++"|"++show b++"|"++show a++")>"
+
+
 -- | Conversion to `RGBA` from another color space with Alpha channel.
-class (ToRGB (Opaque cs), Alpha cs) => ToRGBA cs where
+class (ToRGB (Opaque cs), AlphaSpace cs Double) => ToRGBA cs where
 
   -- | Convert to an `RGBA` pixel.
   toPixelRGBA :: Pixel cs Double -> Pixel RGBA Double
@@ -65,113 +229,291 @@
   toImageRGBA = map toPixelRGBA
   {-# INLINE toImageRGBA #-}
 
+
+instance (Elevator e, Typeable e) => ColorSpace RGBA e where
+  type Components RGBA e = (e, e, e, e)
+
+  toComponents (PixelRGBA r g b a) = (r, g, b, a)
+  {-# INLINE toComponents #-}
   
-instance ColorSpace RGB where
-  type PixelElt RGB e = (e, e, e)
-  data Pixel RGB e = PixelRGB !e !e !e deriving Eq
+  fromComponents !(r, g, b, a) = PixelRGBA r g b a
+  {-# INLINE fromComponents #-}
 
-  fromChannel !e = PixelRGB e e e
-  {-# INLINE fromChannel #-}
+  broadcastC = pure
+  {-# INLINE broadcastC #-}
 
-  fromElt !(r, g, b) = PixelRGB r g b
-  {-# INLINE fromElt #-}
+  getPxC (PixelRGBA r _ _ _) RedRGBA   = r
+  getPxC (PixelRGBA _ g _ _) GreenRGBA = g
+  getPxC (PixelRGBA _ _ b _) BlueRGBA  = b
+  getPxC (PixelRGBA _ _ _ a) AlphaRGBA = a
+  {-# INLINE getPxC #-}
 
-  toElt (PixelRGB r g b) = (r, g, b)
-  {-# INLINE toElt #-}
+  setPxC (PixelRGBA _ g b a) RedRGBA   r = PixelRGBA r g b a
+  setPxC (PixelRGBA r _ b a) GreenRGBA g = PixelRGBA r g b a
+  setPxC (PixelRGBA r g _ a) BlueRGBA  b = PixelRGBA r g b a
+  setPxC (PixelRGBA r g b _) AlphaRGBA a = PixelRGBA r g b a
+  {-# INLINE setPxC #-}
 
-  getPxCh (PixelRGB r _ _) RedRGB   = r
-  getPxCh (PixelRGB _ g _) GreenRGB = g
-  getPxCh (PixelRGB _ _ b) BlueRGB  = b
-  {-# INLINE getPxCh #-}
-  
-  chOp !f (PixelRGB r g b) = PixelRGB (f RedRGB r) (f GreenRGB g) (f BlueRGB b)
-  {-# INLINE chOp #-}
+  mapPxC f (PixelRGBA r g b a) =
+    PixelRGBA (f RedRGBA r) (f GreenRGBA g) (f BlueRGBA b) (f AlphaRGBA a)
+  {-# INLINE mapPxC #-}
 
-  pxOp !f (PixelRGB r g b) = PixelRGB (f r) (f g) (f b)
-  {-# INLINE pxOp #-}
+  mapPx = fmap
+  {-# INLINE mapPx #-}
 
-  chApp (PixelRGB fr fg fb) (PixelRGB r g b) = PixelRGB (fr r) (fg g) (fb b)
-  {-# INLINE chApp #-}
+  zipWithPx = liftA2
+  {-# INLINE zipWithPx #-}
 
-  pxFoldMap f (PixelRGB r g b) = f r `M.mappend` f g `M.mappend` f b
-  {-# INLINE pxFoldMap #-}
+  foldlPx = foldl'
+  {-# INLINE foldlPx #-}
 
-  csColour RedRGB   = C.opaque C.red
-  csColour GreenRGB = C.opaque C.green
-  csColour BlueRGB  = C.opaque C.blue
-  
 
-instance ColorSpace RGBA where
-  type PixelElt RGBA e = (e, e, e, e)
-  data Pixel RGBA e = PixelRGBA !e !e !e !e deriving Eq
+instance (Elevator e, Typeable e) => AlphaSpace RGBA e where
+  type Opaque RGBA = RGB
 
-  fromChannel !e = PixelRGBA e e e e
-  {-# INLINE fromChannel #-}
+  getAlpha (PixelRGBA _ _ _ a) = a
+  {-# INLINE getAlpha #-}
+  addAlpha !a (PixelRGB r g b) = PixelRGBA r g b a
+  {-# INLINE addAlpha #-}
+  dropAlpha (PixelRGBA r g b _) = PixelRGB r g b
+  {-# INLINE dropAlpha #-}
 
-  fromElt (r, g, b, a) = PixelRGBA r g b a
-  {-# INLINE fromElt #-}
 
-  toElt (PixelRGBA r g b a) = (r, g, b, a)
-  {-# INLINE toElt #-}
 
-  getPxCh (PixelRGBA r _ _ _) RedRGBA   = r
-  getPxCh (PixelRGBA _ g _ _) GreenRGBA = g
-  getPxCh (PixelRGBA _ _ b _) BlueRGBA  = b
-  getPxCh (PixelRGBA _ _ _ a) AlphaRGBA = a
-  {-# INLINE getPxCh #-}
+instance Functor (Pixel RGBA) where
+  fmap f (PixelRGBA r g b a) = PixelRGBA (f r) (f g) (f b) (f a)
+  {-# INLINE fmap #-}
+
+instance Applicative (Pixel RGBA) where
+  pure !e = PixelRGBA e e e e
+  {-# INLINE pure #-}
+  (PixelRGBA fr fg fb fa) <*> (PixelRGBA r g b a) = PixelRGBA (fr r) (fg g) (fb b) (fa a)
+  {-# INLINE (<*>) #-}
+
+instance Foldable (Pixel RGBA) where
+  foldr f !z (PixelRGBA r g b a) = f r (f g (f b (f a z)))
+  {-# INLINE foldr #-}
+
+
+
+instance Num e => Num (Pixel RGBA e) where
+  (+)         = liftA2 (+)
+  {-# INLINE (+) #-}
+  (-)         = liftA2 (-)
+  {-# INLINE (-) #-}
+  (*)         = liftA2 (*)
+  {-# INLINE (*) #-}
+  abs         = liftA abs
+  {-# INLINE abs #-}
+  signum      = liftA signum
+  {-# INLINE signum #-}
+  fromInteger = pure . fromInteger
+  {-# INLINE fromInteger #-}
+
+
+instance Fractional e => Fractional (Pixel RGBA e) where
+  (/)          = liftA2 (/)
+  {-# INLINE (/) #-}
+  recip        = liftA recip
+  {-# INLINE recip #-}
+  fromRational = pure . fromRational
+  {-# INLINE fromRational #-}
+
+
+instance Floating e => Floating (Pixel RGBA e) where
+  pi      = pure pi
+  {-# INLINE pi #-}
+  exp     = liftA exp
+  {-# INLINE exp #-}
+  log     = liftA log
+  {-# INLINE log #-}
+  sin     = liftA sin
+  {-# INLINE sin #-}
+  cos     = liftA cos
+  {-# INLINE cos #-}
+  asin    = liftA asin
+  {-# INLINE asin #-}
+  atan    = liftA atan
+  {-# INLINE atan #-}
+  acos    = liftA acos
+  {-# INLINE acos #-}
+  sinh    = liftA sinh
+  {-# INLINE sinh #-}
+  cosh    = liftA cosh
+  {-# INLINE cosh #-}
+  asinh   = liftA asinh
+  {-# INLINE asinh #-}
+  atanh   = liftA atanh
+  {-# INLINE atanh #-}
+  acosh   = liftA acosh
+  {-# INLINE acosh #-}
+
+ 
+instance Storable e => Storable (Pixel RGBA e) where
+
+  sizeOf _ = 3 * sizeOf (undefined :: e)
+  alignment _ = alignment (undefined :: e)
+  peek p = do
+    q <- return $ castPtr p
+    r <- peek q
+    g <- peekElemOff q 1
+    b <- peekElemOff q 2
+    a <- peekElemOff q 3
+    return (PixelRGBA r g b a)
+  poke p (PixelRGBA r g b a) = do
+    q <- return $ castPtr p
+    poke q r
+    pokeElemOff q 1 g
+    pokeElemOff q 2 b
+    pokeElemOff q 3 a
+
+
+
+
+
+------------------------------------------------
+
+-- -- | Red, Green and Blue color space.
+-- data RGB16 = RedRGB16
+--           | GreenRGB16
+--           | BlueRGB16 deriving (Eq, Enum, Typeable, Show)
+
+
+-- --data instance Pixel RGB16 Word16 = PixelRGB16 !Word16 !Word16 !Word16 deriving Eq
+-- data instance Pixel RGB16 Word16 = PixelRGB16
+--                                    {-# UNPACK #-} !Word16
+--                                    {-# UNPACK #-} !Word16
+--                                    {-# UNPACK #-} !Word16 deriving Eq
+-- --data instance Pixel RGB16 Word16 = PixelRGB16 
+
+-- instance ColorSpace RGB16 Word16 where
+--   type Components RGB16 Word16 = (Word16, Word16, Word16)
+
+--   broadcastC !e = PixelRGB16 e e e
+--   {-# INLINE broadcastC #-}
+
+--   toComponents (PixelRGB16 r g b) = (r, g, b)
+--   {-# INLINE toComponents #-}
   
-  chOp !f (PixelRGBA r g b a) =
-    PixelRGBA (f RedRGBA r) (f GreenRGBA g) (f BlueRGBA b) (f AlphaRGBA a)
-  {-# INLINE chOp #-}
+--   fromComponents !(r, g, b) = PixelRGB16 r g b
+--   {-# INLINE fromComponents #-}
 
-  pxOp !f (PixelRGBA r g b a) = PixelRGBA (f r) (f g) (f b) (f a)
-  {-# INLINE pxOp #-}
 
-  chApp (PixelRGBA fr fg fb fa) (PixelRGBA r g b a) = PixelRGBA (fr r) (fg g) (fb b) (fa a)
-  {-# INLINE chApp #-}
+--   getPxC (PixelRGB16 r _ _) RedRGB16   = r
+--   getPxC (PixelRGB16 _ g _) GreenRGB16 = g
+--   getPxC (PixelRGB16 _ _ b) BlueRGB16  = b
+--   {-# INLINE getPxC #-}
 
-  pxFoldMap f (PixelRGBA r g b a) = f r `M.mappend` f g `M.mappend` f b `M.mappend` f a
-  {-# INLINE pxFoldMap #-}
+--   setPxC (PixelRGB16 _ g b) RedRGB16   r = PixelRGB16 r g b
+--   setPxC (PixelRGB16 r _ b) GreenRGB16 g = PixelRGB16 r g b
+--   setPxC (PixelRGB16 r g _) BlueRGB16  b = PixelRGB16 r g b
+--   {-# INLINE setPxC #-}
 
-  csColour AlphaRGBA = C.opaque C.gray
-  csColour ch        = csColour $ opaque ch
+--   mapPxC f (PixelRGB16 r g b) = PixelRGB16 (f RedRGB16 r) (f GreenRGB16 g) (f BlueRGB16 b)
+--   {-# INLINE mapPxC #-}
 
+--   mapPx f (PixelRGB16 r g b) = PixelRGB16 (f r) (f g) (f b)
+--   {-# INLINE mapPx #-}
 
-instance Alpha RGBA where
-  type Opaque RGBA = RGB
+--   zipWithPx f (PixelRGB16 r1 g1 b1) (PixelRGB16 r2 g2 b2) =
+--     PixelRGB16 (f r1 r2) (f g1 g2) (f b1 b2)
+--   {-# INLINE zipWithPx #-}
 
-  getAlpha (PixelRGBA _ _ _ a) = a
-  {-# INLINE getAlpha #-}
+--   foldlPx f !acc (PixelRGB16 r g b) = f (f (f acc r) g) b
+
+
+-- instance Num (Pixel RGB16 Word16) where
+--   (+)         = zipWithPx (+)
   
-  addAlpha !a (PixelRGB r g b) = PixelRGBA r g b a
-  {-# INLINE addAlpha #-}
+--   (-)         = zipWithPx (-)
+--   {-# INLINE (-) #-}
+  
+--   (*)         = zipWithPx (*)
+--   {-# INLINE (*) #-}
+  
+--   abs         = mapPx abs
+--   {-# INLINE abs #-}
+  
+--   signum      = mapPx signum
+--   {-# INLINE signum #-}
+  
+--   fromInteger = broadcastC . fromInteger
+--   {-# INLINE fromInteger #-}
 
-  dropAlpha (PixelRGBA r g b _) = PixelRGB r g b
-  {-# INLINE dropAlpha #-}
 
-  opaque RedRGBA   = RedRGB
-  opaque GreenRGBA = GreenRGB
-  opaque BlueRGBA  = BlueRGB
-  opaque AlphaRGBA = error "Data.Image.ColorSpace.RGB (Alpha.opaque)"
+-- -- instance Fractional (Pixel RGB16 Word16) where
+-- --   (/)          = zipWithPx (/)
+-- --   {-# INLINE (/) #-}
+  
+-- --   recip        = mapPx recip
+-- --   {-# INLINE recip #-}
 
+-- --   fromRational = broadcastC . fromRational
+-- --   {-# INLINE fromRational #-}
 
-instance Show RGB where
-  show RedRGB   = "Red"
-  show GreenRGB = "Green"
-  show BlueRGB  = "Blue"
 
+-- -- instance Floating (Pixel RGB16 Word16) where
+-- --   pi      = broadcastC pi
+-- --   {-# INLINE pi #-}
 
-instance Show RGBA where
-  show AlphaRGBA = "Alpha"
-  show ch        = show $ opaque ch
+-- --   exp     = mapPx exp
+-- --   {-# INLINE exp #-}
 
- 
-instance Show e => Show (Pixel RGB e) where
-  show (PixelRGB r g b) = "<RGB:("++show r++"|"++show g++"|"++show b++")>"
+-- --   log     = mapPx log
+-- --   {-# INLINE log #-}
+  
+-- --   sin     = mapPx sin
+-- --   {-# INLINE sin #-}
+  
+-- --   cos     = mapPx cos
+-- --   {-# INLINE cos #-}
+  
+-- --   asin    = mapPx asin
+-- --   {-# INLINE asin #-}
+  
+-- --   atan    = mapPx atan
+-- --   {-# INLINE atan #-}
+  
+-- --   acos    = mapPx acos
+-- --   {-# INLINE acos #-}
+  
+-- --   sinh    = mapPx sinh
+-- --   {-# INLINE sinh #-}
+  
+-- --   cosh    = mapPx cosh
+-- --   {-# INLINE cosh #-}
+  
+-- --   asinh   = mapPx asinh
+-- --   {-# INLINE asinh #-}
+  
+-- --   atanh   = mapPx atanh
+-- --   {-# INLINE atanh #-}
+  
+-- --   acosh   = mapPx acosh
+-- --   {-# INLINE acosh #-}
 
 
-instance Show e => Show (Pixel RGBA e) where
-  show (PixelRGBA r g b a) = "<RGBA:("++show r++"|"++show g++"|"++show b++"|"++show a++")>"
+-- -- instance Show RGB16 where
+-- --   show RedRGB16   = "Red"
+-- --   show GreenRGB16 = "Green"
+-- --   show BlueRGB16  = "Blue"
 
+-- -- instance Show (Pixel RGB16 Word16) where
+-- --   show (PixelRGB16 r g b) = "<RGB:("++show r++"|"++show g++"|"++show b++")>"
 
 
+-- -- instance Storable (Pixel RGB16 Word16) where
+
+-- --   sizeOf _ = 3 * sizeOf (undefined :: Word16)
+-- --   alignment _ = alignment (undefined :: Word16)
+-- --   peek p = do
+-- --     q <- return $ castPtr p
+-- --     r <- peek q
+-- --     g <- peekElemOff q 1
+-- --     b <- peekElemOff q 2
+-- --     return (PixelRGB16 r g b)
+-- --   poke p (PixelRGB16 r g b) = do
+-- --     q <- return $ castPtr p
+-- --     poke q r
+-- --     pokeElemOff q 1 g
+-- --     pokeElemOff q 2 b
diff --git a/src/Graphics/Image/ColorSpace/YCbCr.hs b/src/Graphics/Image/ColorSpace/YCbCr.hs
--- a/src/Graphics/Image/ColorSpace/YCbCr.hs
+++ b/src/Graphics/Image/ColorSpace/YCbCr.hs
@@ -2,10 +2,12 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
 -- |
 -- Module      : Graphics.Image.ColorSpace.YCbCr
--- Copyright   : (c) Alexey Kuleshevich 2016
+-- Copyright   : (c) Alexey Kuleshevich 2017
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -17,20 +19,159 @@
   ) where
 
 import Prelude hiding (map)
-import Graphics.Image.Interface
+import Control.Applicative
+import Data.Foldable
 import Data.Typeable (Typeable)
-import qualified Data.Monoid as M (mappend)
-import qualified Data.Colour as C
-import qualified Data.Colour.Names as C
+import Foreign.Ptr
+import Foreign.Storable
 
+import Graphics.Image.Interface
 
+
+-------------
+--- YCbCr ---
+-------------
+
+
 -- | Color space is used to encode RGB information and is used in JPEG compression.
 data YCbCr = LumaYCbCr  -- ^ Luma component (commonly denoted as __Y'__)
            | CBlueYCbCr -- ^ Blue difference chroma component
            | CRedYCbCr  -- ^ Red difference chroma component
            deriving (Eq, Enum, Typeable)
 
+data instance Pixel YCbCr e = PixelYCbCr !e !e !e deriving Eq
 
+
+instance Show YCbCr where
+  show LumaYCbCr  = "Luma"
+  show CBlueYCbCr = "Blue Chroma"
+  show CRedYCbCr  = "Red Chroma"
+
+
+instance Show e => Show (Pixel YCbCr e) where
+  show (PixelYCbCr y b r) = "<YCbCr:("++show y++"|"++show b++"|"++show r++")>"
+
+
+instance (Elevator e, Typeable e) => ColorSpace YCbCr e where
+  type Components YCbCr e = (e, e, e)
+
+  broadcastC !e = PixelYCbCr e e e
+  {-# INLINE broadcastC #-}
+  fromComponents !(y, b, r) = PixelYCbCr y b r
+  {-# INLINE fromComponents #-}
+  toComponents (PixelYCbCr y b r) = (y, b, r)
+  {-# INLINE toComponents #-}
+  getPxC (PixelYCbCr y _ _) LumaYCbCr  = y
+  getPxC (PixelYCbCr _ b _) CBlueYCbCr = b
+  getPxC (PixelYCbCr _ _ r) CRedYCbCr  = r
+  {-# INLINE getPxC #-}
+  setPxC (PixelYCbCr _ b r) LumaYCbCr  y = PixelYCbCr y b r
+  setPxC (PixelYCbCr y _ r) CBlueYCbCr b = PixelYCbCr y b r
+  setPxC (PixelYCbCr y b _) CRedYCbCr  r = PixelYCbCr y b r
+  {-# INLINE setPxC #-}
+  mapPxC f (PixelYCbCr y b r) = PixelYCbCr (f LumaYCbCr y) (f CBlueYCbCr b) (f CRedYCbCr r)
+  {-# INLINE mapPxC #-}
+  mapPx = fmap
+  {-# INLINE mapPx #-}
+  zipWithPx = liftA2
+  {-# INLINE zipWithPx #-}
+  foldlPx = foldl'
+  {-# INLINE foldlPx #-}
+
+
+instance Functor (Pixel YCbCr) where
+  fmap f (PixelYCbCr y b r) = PixelYCbCr (f y) (f b) (f r)
+  {-# INLINE fmap #-}
+
+
+instance Applicative (Pixel YCbCr) where
+  pure !e = PixelYCbCr e e e
+  {-# INLINE pure #-}
+  (PixelYCbCr fy fb fr) <*> (PixelYCbCr y b r) = PixelYCbCr (fy y) (fb b) (fr r)
+  {-# INLINE (<*>) #-}
+
+
+instance Foldable (Pixel YCbCr) where
+  foldr f !z (PixelYCbCr y b r) = f y (f b (f r z))
+  {-# INLINE foldr #-}
+
+
+instance Num e => Num (Pixel YCbCr e) where
+  (+)         = liftA2 (+)
+  {-# INLINE (+) #-}
+  (-)         = liftA2 (-)
+  {-# INLINE (-) #-}
+  (*)         = liftA2 (*)
+  {-# INLINE (*) #-}
+  abs         = liftA abs
+  {-# INLINE abs #-}
+  signum      = liftA signum
+  {-# INLINE signum #-}
+  fromInteger = pure . fromInteger
+  {-# INLINE fromInteger #-}
+
+
+instance Fractional e => Fractional (Pixel YCbCr e) where
+  (/)          = liftA2 (/)
+  {-# INLINE (/) #-}
+  recip        = liftA recip
+  {-# INLINE recip #-}
+  fromRational = pure . fromRational
+  {-# INLINE fromRational #-}
+
+
+instance Floating e => Floating (Pixel YCbCr e) where
+  pi      = pure pi
+  {-# INLINE pi #-}
+  exp     = liftA exp
+  {-# INLINE exp #-}
+  log     = liftA log
+  {-# INLINE log #-}
+  sin     = liftA sin
+  {-# INLINE sin #-}
+  cos     = liftA cos
+  {-# INLINE cos #-}
+  asin    = liftA asin
+  {-# INLINE asin #-}
+  atan    = liftA atan
+  {-# INLINE atan #-}
+  acos    = liftA acos
+  {-# INLINE acos #-}
+  sinh    = liftA sinh
+  {-# INLINE sinh #-}
+  cosh    = liftA cosh
+  {-# INLINE cosh #-}
+  asinh   = liftA asinh
+  {-# INLINE asinh #-}
+  atanh   = liftA atanh
+  {-# INLINE atanh #-}
+  acosh   = liftA acosh
+  {-# INLINE acosh #-}
+
+
+
+instance Storable e => Storable (Pixel YCbCr e) where
+
+  sizeOf _ = 3 * sizeOf (undefined :: e)
+  alignment _ = alignment (undefined :: e)
+  peek p = do
+    q <- return $ castPtr p
+    y <- peek q
+    b <- peekElemOff q 1
+    r <- peekElemOff q 2
+    return (PixelYCbCr y b r)
+  poke p (PixelYCbCr y b r) = do
+    q <- return $ castPtr p
+    pokeElemOff q 0 y
+    pokeElemOff q 1 b
+    pokeElemOff q 2 r
+
+
+--------------
+--- YCbCrA ---
+--------------
+
+
 -- | YCbCr color space with Alpha channel.
 data YCbCrA = LumaYCbCrA  -- ^ Luma component (commonly denoted as __Y'__)
             | CBlueYCbCrA -- ^ Blue difference chroma component
@@ -38,9 +179,52 @@
             | AlphaYCbCrA -- ^ Alpha component.
             deriving (Eq, Enum, Typeable)
 
+data instance Pixel YCbCrA e = PixelYCbCrA !e !e !e !e deriving Eq
 
+
+instance Show YCbCrA where
+  show LumaYCbCrA  = "Luma"
+  show CBlueYCbCrA = "Blue Chroma"
+  show CRedYCbCrA  = "Red Chroma"
+  show AlphaYCbCrA = "Alpha"
+
+ 
+instance Show e => Show (Pixel YCbCrA e) where
+  show (PixelYCbCrA y b r a) = "<YCbCrA:("++show y++"|"++show b++"|"++show r++"|"++show a++")>"
+
+
+instance (Elevator e, Typeable e) => ColorSpace YCbCrA e where
+  type Components YCbCrA e = (e, e, e, e)
+
+  broadcastC !e = PixelYCbCrA e e e e
+  {-# INLINE broadcastC #-}
+  fromComponents !(y, b, r, a) = PixelYCbCrA y b r a
+  {-# INLINE fromComponents #-}
+  toComponents (PixelYCbCrA y b r a) = (y, b, r, a)
+  {-# INLINE toComponents #-}
+  getPxC (PixelYCbCrA y _ _ _) LumaYCbCrA  = y
+  getPxC (PixelYCbCrA _ b _ _) CBlueYCbCrA = b
+  getPxC (PixelYCbCrA _ _ r _) CRedYCbCrA  = r
+  getPxC (PixelYCbCrA _ _ _ a) AlphaYCbCrA = a
+  {-# INLINE getPxC #-}
+  setPxC (PixelYCbCrA _ b r a) LumaYCbCrA  y = PixelYCbCrA y b r a
+  setPxC (PixelYCbCrA y _ r a) CBlueYCbCrA b = PixelYCbCrA y b r a
+  setPxC (PixelYCbCrA y b _ a) CRedYCbCrA  r = PixelYCbCrA y b r a
+  setPxC (PixelYCbCrA y b r _) AlphaYCbCrA a = PixelYCbCrA y b r a
+  {-# INLINE setPxC #-}
+  mapPxC f (PixelYCbCrA y b r a) =
+    PixelYCbCrA (f LumaYCbCrA y) (f CBlueYCbCrA b) (f CRedYCbCrA r) (f AlphaYCbCrA a)
+  {-# INLINE mapPxC #-}
+  mapPx = fmap
+  {-# INLINE mapPx #-}
+  zipWithPx = liftA2
+  {-# INLINE zipWithPx #-}
+  foldlPx = foldl'
+  {-# INLINE foldlPx #-}
+
+  
 -- | Conversion to `YCbCr` color space.
-class ColorSpace cs => ToYCbCr cs where
+class ColorSpace cs Double => ToYCbCr cs where
 
   -- | Convert to an `YCbCr` pixel.
   toPixelYCbCr :: Pixel cs Double -> Pixel YCbCr Double
@@ -54,7 +238,7 @@
 
 
 -- | Conversion to `YCbCrA` from another color space with Alpha channel.
-class (ToYCbCr (Opaque cs), Alpha cs) => ToYCbCrA cs where
+class (ToYCbCr (Opaque cs), AlphaSpace cs Double) => ToYCbCrA cs where
 
   -- | Convert to an `YCbCrA` pixel.
   toPixelYCbCrA :: Pixel cs Double -> Pixel YCbCrA Double
@@ -69,112 +253,104 @@
   {-# INLINE toImageYCbCrA #-}
 
   
-instance ColorSpace YCbCr where
-  type PixelElt YCbCr e = (e, e, e)
-  data Pixel YCbCr e = PixelYCbCr !e !e !e deriving Eq
 
-  fromChannel !e = PixelYCbCr e e e
-  {-# INLINE fromChannel #-}
-
-  fromElt !(y, b, r) = PixelYCbCr y b r
-  {-# INLINE fromElt #-}
-
-  toElt (PixelYCbCr y b r) = (y, b, r)
-  {-# INLINE toElt #-}
-
-  getPxCh (PixelYCbCr y _ _) LumaYCbCr  = y
-  getPxCh (PixelYCbCr _ b _) CBlueYCbCr = b
-  getPxCh (PixelYCbCr _ _ r) CRedYCbCr  = r
-  {-# INLINE getPxCh #-}
-  
-  chOp !f (PixelYCbCr y b r) = PixelYCbCr (f LumaYCbCr y) (f CBlueYCbCr b) (f CRedYCbCr r)
-  {-# INLINE chOp #-}
-
-  pxOp !f (PixelYCbCr y b r) = PixelYCbCr (f y) (f b) (f r)
-  {-# INLINE pxOp #-}
-
-  chApp (PixelYCbCr fy fb fr) (PixelYCbCr y b r) = PixelYCbCr (fy y) (fb b) (fr r)
-  {-# INLINE chApp #-}
-
-  pxFoldMap f (PixelYCbCr y b r) = f y `M.mappend` f b `M.mappend` f r
-  {-# INLINE pxFoldMap #-}
-
-  csColour LumaYCbCr  = C.opaque C.darkgray
-  csColour CBlueYCbCr = C.opaque C.darkblue
-  csColour CRedYCbCr  = C.opaque C.darkred
-  
-
-instance ColorSpace YCbCrA where
-  type PixelElt YCbCrA e = (e, e, e, e)
-  data Pixel YCbCrA e = PixelYCbCrA !e !e !e !e deriving Eq
-
-  fromChannel !e = PixelYCbCrA e e e e
-  {-# INLINE fromChannel #-}
-
-  fromElt (y, b, r, a) = PixelYCbCrA y b r a
-  {-# INLINE fromElt #-}
-
-  toElt (PixelYCbCrA y b r a) = (y, b, r, a)
-  {-# INLINE toElt #-}
-
-  getPxCh (PixelYCbCrA y _ _ _) LumaYCbCrA  = y
-  getPxCh (PixelYCbCrA _ b _ _) CBlueYCbCrA = b
-  getPxCh (PixelYCbCrA _ _ r _) CRedYCbCrA  = r
-  getPxCh (PixelYCbCrA _ _ _ a) AlphaYCbCrA = a
-  {-# INLINE getPxCh #-}
-  
-  chOp !f (PixelYCbCrA y b r a) =
-    PixelYCbCrA (f LumaYCbCrA y) (f CBlueYCbCrA b) (f CRedYCbCrA r) (f AlphaYCbCrA a)
-  {-# INLINE chOp #-}
-
-  pxOp !f (PixelYCbCrA y b r a) = PixelYCbCrA (f y) (f b) (f r) (f a)
-  {-# INLINE pxOp #-}
-
-  chApp (PixelYCbCrA fy fb fr fa) (PixelYCbCrA y b r a) = PixelYCbCrA (fy y) (fb b) (fr r) (fa a)
-  {-# INLINE chApp #-}
-
-  pxFoldMap f (PixelYCbCrA y b r a) = f y `M.mappend` f b `M.mappend` f r `M.mappend` f a
-  {-# INLINE pxFoldMap #-}
-
-  csColour AlphaYCbCrA = C.opaque C.gray
-  csColour ch          = csColour $ opaque ch
-
-
-instance Alpha YCbCrA where
+instance (Elevator e, Typeable e) => AlphaSpace YCbCrA e where
   type Opaque YCbCrA = YCbCr
 
   getAlpha (PixelYCbCrA _ _ _ a) = a
   {-# INLINE getAlpha #-}
-  
   addAlpha !a (PixelYCbCr y b r) = PixelYCbCrA y b r a
   {-# INLINE addAlpha #-}
-
   dropAlpha (PixelYCbCrA y b r _) = PixelYCbCr y b r
   {-# INLINE dropAlpha #-}
 
-  opaque LumaYCbCrA  = LumaYCbCr
-  opaque CBlueYCbCrA = CBlueYCbCr
-  opaque CRedYCbCrA  = CRedYCbCr
-  opaque AlphaYCbCrA = error "Data.Image.ColorSpace.YCbCr (Alpha.opaque)"
 
+instance Functor (Pixel YCbCrA) where
+  fmap f (PixelYCbCrA y b r a) = PixelYCbCrA (f y) (f b) (f r) (f a)
+  {-# INLINE fmap #-}
 
-instance Show YCbCr where
-  show LumaYCbCr  = "Luma"
-  show CBlueYCbCr = "Blue Chroma"
-  show CRedYCbCr  = "Red Chroma"
 
+instance Applicative (Pixel YCbCrA) where
+  pure !e = PixelYCbCrA e e e e
+  {-# INLINE pure #-}
+  (PixelYCbCrA fy fb fr fa) <*> (PixelYCbCrA y b r a) = PixelYCbCrA (fy y) (fb b) (fr r) (fa a)
+  {-# INLINE (<*>) #-}
 
-instance Show YCbCrA where
-  show AlphaYCbCrA = "Alpha"
-  show ch          = show $ opaque ch
 
- 
-instance Show e => Show (Pixel YCbCr e) where
-  show (PixelYCbCr y b r) = "<YCbCr:("++show y++"|"++show b++"|"++show r++")>"
+instance Foldable (Pixel YCbCrA) where
+  foldr f !z (PixelYCbCrA y b r a) = f y (f b (f r (f a z)))
+  {-# INLINE foldr #-}
 
 
-instance Show e => Show (Pixel YCbCrA e) where
-  show (PixelYCbCrA y b r a) = "<YCbCrA:("++show y++"|"++show b++"|"++show r++"|"++show a++")>"
+instance Num e => Num (Pixel YCbCrA e) where
+  (+)         = liftA2 (+)
+  {-# INLINE (+) #-}
+  (-)         = liftA2 (-)
+  {-# INLINE (-) #-}
+  (*)         = liftA2 (*)
+  {-# INLINE (*) #-}
+  abs         = liftA abs
+  {-# INLINE abs #-}
+  signum      = liftA signum
+  {-# INLINE signum #-}
+  fromInteger = pure . fromInteger
+  {-# INLINE fromInteger #-}
 
+
+instance Fractional e => Fractional (Pixel YCbCrA e) where
+  (/)          = liftA2 (/)
+  {-# INLINE (/) #-}
+  recip        = liftA recip
+  {-# INLINE recip #-}
+  fromRational = pure . fromRational
+  {-# INLINE fromRational #-}
+
+
+instance Floating e => Floating (Pixel YCbCrA e) where
+  pi      = pure pi
+  {-# INLINE pi #-}
+  exp     = liftA exp
+  {-# INLINE exp #-}
+  log     = liftA log
+  {-# INLINE log #-}
+  sin     = liftA sin
+  {-# INLINE sin #-}
+  cos     = liftA cos
+  {-# INLINE cos #-}
+  asin    = liftA asin
+  {-# INLINE asin #-}
+  atan    = liftA atan
+  {-# INLINE atan #-}
+  acos    = liftA acos
+  {-# INLINE acos #-}
+  sinh    = liftA sinh
+  {-# INLINE sinh #-}
+  cosh    = liftA cosh
+  {-# INLINE cosh #-}
+  asinh   = liftA asinh
+  {-# INLINE asinh #-}
+  atanh   = liftA atanh
+  {-# INLINE atanh #-}
+  acosh   = liftA acosh
+  {-# INLINE acosh #-}
+
+
+instance Storable e => Storable (Pixel YCbCrA e) where
+
+  sizeOf _ = 3 * sizeOf (undefined :: e)
+  alignment _ = alignment (undefined :: e)
+  peek p = do
+    q <- return $ castPtr p
+    y <- peekElemOff q 0
+    b <- peekElemOff q 1
+    r <- peekElemOff q 2
+    a <- peekElemOff q 3
+    return (PixelYCbCrA y b r a)
+  poke p (PixelYCbCrA y b r a) = do
+    q <- return $ castPtr p
+    poke q y
+    pokeElemOff q 1 b
+    pokeElemOff q 2 r
+    pokeElemOff q 3 a
 
 
diff --git a/src/Graphics/Image/IO.hs b/src/Graphics/Image/IO.hs
--- a/src/Graphics/Image/IO.hs
+++ b/src/Graphics/Image/IO.hs
@@ -3,7 +3,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 -- |
 -- Module      : Graphics.Image.IO
--- Copyright   : (c) Alexey Kuleshevich 2016
+-- Copyright   : (c) Alexey Kuleshevich 2017
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -41,10 +41,6 @@
 import Data.Maybe (fromMaybe)
 
 import qualified Data.ByteString as B (readFile)
-import Graphics.Image.ColorSpace
-import Graphics.Image.Interface
-import Graphics.Image.IO.Base
-import Graphics.Image.IO.Formats
 import qualified Data.ByteString.Lazy as BL (writeFile, hPut)
 import System.Directory (createDirectoryIfMissing, getTemporaryDirectory)
 import System.FilePath (takeExtension, (</>))
@@ -52,6 +48,10 @@
 import System.Process (readProcess)
 import Control.Exception (bracket)
 
+import Graphics.Image.ColorSpace
+import Graphics.Image.Interface
+import Graphics.Image.IO.Base
+import Graphics.Image.IO.Formats
 
 -- | External viewing application to use for displaying images.
 data ExternalViewer =
@@ -111,12 +111,12 @@
 -- Attempt to read an image in a particular color space that is not supported by
 -- the format, will result in a compile error. Refer to 'Readable' class for all
 -- images that can be decoded.
-readImageExact :: Readable img format =>
+readImageExact :: Readable (Image arr cs e) format =>
                   format
                   -- ^ A file format that an image should be read as. See
                    -- <#g:4 Supported Image Formats>
                -> FilePath -- ^ Location of an image.
-               -> IO (Either String img)
+               -> IO (Either String (Image arr cs e))
 readImageExact format path = fmap (decode format) (B.readFile path)
 
 
@@ -144,20 +144,20 @@
 -- options. Precision and color space, that an image will be written as, is decided
 -- from image's type. Attempt to write image file in a format that does not
 -- support color space and precision combination will result in a compile error.
-writeImageExact :: Writable img format =>
+writeImageExact :: Writable (Image arr cs e) format =>
                    format
                    -- ^ A file format that an image should be saved in. See
                    -- <#g:4 Supported Image Formats>
                 -> [SaveOption format] -- ^ A list of format specific options.
                 -> FilePath -- ^ Location where an image should be written.
-                -> img -- ^ An image to write. Can be a list of images in case
+                -> (Image arr cs e) -- ^ An image to write. Can be a list of images in case
                        -- of formats supporting animation.
                 -> IO ()
 writeImageExact format opts path = BL.writeFile path . encode format opts
   
 
-{- | An image is written as a @.tiff@ file into an operating system's temporary
-directory and passed as an argument to the external viewer program. -}
+-- | An image is written as a @.tiff@ file into an operating system's temporary
+-- directory and passed as an argument to the external viewer program.
 displayImageUsing :: Writable (Image arr cs e) TIF =>
                      ExternalViewer -- ^ External viewer to use
                   -> Bool -- ^ Should the call be blocking
diff --git a/src/Graphics/Image/IO/Formats/JuicyPixels.hs b/src/Graphics/Image/IO/Formats/JuicyPixels.hs
--- a/src/Graphics/Image/IO/Formats/JuicyPixels.hs
+++ b/src/Graphics/Image/IO/Formats/JuicyPixels.hs
@@ -24,11 +24,13 @@
   SaveOption(..),
   ) where
 
+import Prelude as P
 import GHC.Float
 import Data.Either
 import qualified Data.Monoid as M (mempty)
 import Graphics.Image.ColorSpace
-import Graphics.Image.Interface hiding (map)
+import Graphics.Image.Interface as I
+import Graphics.Image.Interface.Vector
 import Graphics.Image.IO.Base
 import qualified Data.ByteString as B (ByteString)
 import qualified Data.ByteString.Lazy as BL (ByteString)
@@ -36,7 +38,7 @@
 import qualified Codec.Picture.Jpg as JP
 import qualified Codec.Picture.Types as JP
 import qualified Codec.Picture.ColorQuant as JP
-
+import qualified Data.Vector.Storable as V
 
 -- | Bitmap image with @.bmp@ extension.
 data BMP = BMP
@@ -119,13 +121,13 @@
 -- Y -> Y (Double)
 
 instance Convertible JP.Pixel8 (Pixel Y Double) where
-  convert = toDouble . PixelY
+  convert = fmap toDouble . PixelY
 
 instance Convertible JP.Pixel16 (Pixel Y Double) where
-  convert = toDouble . PixelY
+  convert = fmap toDouble . PixelY
 
 instance Convertible JP.PixelF (Pixel Y Double) where
-  convert = toDouble . PixelY
+  convert = fmap toDouble . PixelY
 
 instance Convertible JP.PixelYA8 (Pixel Y Double) where
   convert = convert . JP.dropTransparency
@@ -143,10 +145,10 @@
   convert = addAlpha 1 . convert
 
 instance Convertible JP.PixelYA8 (Pixel YA Double) where
-  convert (JP.PixelYA8 y a) = toDouble (PixelYA y a)
+  convert (JP.PixelYA8 y a) = fmap toDouble (PixelYA y a)
 
 instance Convertible JP.PixelYA16 (Pixel YA Double) where
-  convert (JP.PixelYA16 y a) = toDouble (PixelYA y a)
+  convert (JP.PixelYA16 y a) = fmap toDouble (PixelYA y a)
 
 
 -- Color -> Y (Double)
@@ -167,10 +169,10 @@
   convert = toPixelY . (convert :: JP.PixelRGBF -> Pixel RGB Double)
 
 instance Convertible JP.PixelCMYK8 (Pixel Y Double) where
-  convert = toPixelY . toDouble . (convert :: JP.PixelCMYK8 -> Pixel CMYK Word8)
+  convert = toPixelY . fmap toDouble . (convert :: JP.PixelCMYK8 -> Pixel CMYK Word8)
 
 instance Convertible JP.PixelCMYK16 (Pixel Y Double) where
-  convert = toPixelY . toDouble . (convert :: JP.PixelCMYK16 -> Pixel CMYK Word16)
+  convert = toPixelY . fmap toDouble . (convert :: JP.PixelCMYK16 -> Pixel CMYK Word16)
 
 instance Convertible JP.PixelYCbCr8 (Pixel Y Double) where
   convert = convert . JP.computeLuma
@@ -206,13 +208,13 @@
 -- Y -> RGB (Double)
 
 instance Convertible JP.Pixel8 (Pixel RGB Double) where
-  convert = toDouble . fromChannel
+  convert = broadcastC . toDouble
 
 instance Convertible JP.Pixel16 (Pixel RGB Double) where
-  convert = toDouble . fromChannel
+  convert = broadcastC . toDouble
 
 instance Convertible JP.PixelF (Pixel RGB Double) where
-  convert = toDouble . fromChannel
+  convert = broadcastC . toDouble
 
 instance Convertible JP.PixelYA8 (Pixel RGB Double) where
   convert = convert . JP.dropTransparency
@@ -223,10 +225,10 @@
 -- Color -> RGB (Double)
 
 instance Convertible JP.PixelRGB8 (Pixel RGB Double) where
-  convert (JP.PixelRGB8 r g b) = toDouble $ PixelRGB r g b
+  convert (JP.PixelRGB8 r g b) = fmap toDouble $ PixelRGB r g b
 
 instance Convertible JP.PixelRGB16 (Pixel RGB Double) where
-  convert (JP.PixelRGB16 r g b) = toDouble $ PixelRGB r g b
+  convert (JP.PixelRGB16 r g b) = fmap toDouble $ PixelRGB r g b
 
 instance Convertible JP.PixelRGBA8 (Pixel RGB Double) where
   convert = convert . JP.dropTransparency
@@ -285,10 +287,10 @@
   convert = addAlpha 1 . convert
   
 instance Convertible JP.PixelRGBA8 (Pixel RGBA Double) where
-  convert (JP.PixelRGBA8 r g b a) = toDouble $ PixelRGBA r g b a
+  convert (JP.PixelRGBA8 r g b a) = fmap toDouble $ PixelRGBA r g b a
   
 instance Convertible JP.PixelRGBA16 (Pixel RGBA Double) where
-  convert (JP.PixelRGBA16 r g b a) = toDouble $ PixelRGBA r g b a
+  convert (JP.PixelRGBA16 r g b a) = fmap toDouble $ PixelRGBA r g b a
 
 
 ---- to JuicyPixels -----
@@ -391,232 +393,242 @@
 
 -- BMP Format Reading
 
-instance (Array arr Y Word8, Array arr Binary Bit) => Readable (Image arr Binary Bit) BMP where
+instance Readable (Image VS Binary Bit) BMP where
   decode _ = fmap toImageBinary . jpImageY8ToImage . JP.decodeBitmap
 
-instance Array arr Y Word8 => Readable (Image arr Y Word8) BMP where
+instance Readable (Image VS Y Word8) BMP where
   decode _ = jpImageY8ToImage . JP.decodeBitmap
 
-instance Array arr RGB Word8 => Readable (Image arr RGB Word8) BMP where
+instance Readable (Image VS RGB Word8) BMP where
   decode _ = jpImageRGB8ToImage . JP.decodeBitmap
 
-instance Array arr RGBA Word8 => Readable (Image arr RGBA Word8) BMP where
+instance Readable (Image VS RGBA Word8) BMP where
   decode _ = jpImageRGBA8ToImage . JP.decodeBitmap
 
-instance Array arr Y Double => Readable (Image arr Y Double) BMP where
-  decode _ = jpDynamicImageToImage . JP.decodeBitmap
 
-instance Array arr YA Double => Readable (Image arr YA Double) BMP where
-  decode _ = jpDynamicImageToImage . JP.decodeBitmap
 
-instance Array arr RGB Double => Readable (Image arr RGB Double) BMP where
-  decode _ = jpDynamicImageToImage . JP.decodeBitmap
-
-instance Array arr RGBA Double => Readable (Image arr RGBA Double) BMP where
-  decode _ = jpDynamicImageToImage . JP.decodeBitmap
-
-
 -- GIF Format Reading
 
-instance Array arr RGB Word8 => Readable (Image arr RGB Word8) GIF where
+instance Readable (Image VS RGB Word8) GIF where
   decode _ = jpImageRGB8ToImage . JP.decodeGif
 
-instance Array arr RGBA Word8 => Readable (Image arr RGBA Word8) GIF where
+instance Readable (Image VS RGBA Word8) GIF where
   decode _ = jpImageRGBA8ToImage . JP.decodeGif
 
-instance Array arr Y Double => Readable (Image arr Y Double) GIF where
-  decode _ = jpDynamicImageToImage . JP.decodeGif
 
-instance Array arr YA Double => Readable (Image arr YA Double) GIF where
-  decode _ = jpDynamicImageToImage . JP.decodeGif
-
-instance Array arr RGB Double => Readable (Image arr RGB Double) GIF where
-  decode _ = jpDynamicImageToImage . JP.decodeGif
-
-instance Array arr RGBA Double => Readable (Image arr RGBA Double) GIF where
-  decode _ = jpDynamicImageToImage . JP.decodeGif
-
 -- List of GIF Format frames Reading
 
 decodeGifs :: (Either String JP.DynamicImage -> Either String img)
            -> B.ByteString -> Either String [img]
 decodeGifs decoder = either Left decodeLS . JP.decodeGifImages where
     decodeLS ls = if null errs then Right imgs else Left $ unlines errs where
-      (errs, imgs) = partitionEithers $ map (decoder . Right) ls
+      (errs, imgs) = partitionEithers $ P.map (decoder . Right) ls
 
-instance Array arr RGB Word8 => Readable [Image arr RGB Word8] [GIF] where
+instance Readable [Image VS RGB Word8] [GIF] where
   decode _ = decodeGifs jpImageRGB8ToImage
 
-instance Array arr RGBA Word8 => Readable [Image arr RGBA Word8] [GIF] where
+instance Readable [Image VS RGBA Word8] [GIF] where
   decode _ = decodeGifs jpImageRGBA8ToImage
 
-instance Array arr Y Double => Readable [Image arr Y Double] [GIF] where
-  decode _ = decodeGifs jpDynamicImageToImage
 
-instance Array arr YA Double => Readable [Image arr YA Double] [GIF] where
-  decode _ = decodeGifs jpDynamicImageToImage
-
-instance Array arr RGB Double => Readable [Image arr RGB Double] [GIF] where
-  decode _ = decodeGifs jpDynamicImageToImage
-
-instance Array arr RGBA Double => Readable [Image arr RGBA Double] [GIF] where
-  decode _ = decodeGifs jpDynamicImageToImage
-  
-
-
 -- HDR Format Reading
 
-instance Array arr RGB Float => Readable (Image arr RGB Float) HDR where
+instance Readable (Image VS RGB Float) HDR where
   decode _ = jpImageRGBFToImage . JP.decodeHDR
 
-instance Array arr Y Double => Readable (Image arr Y Double) HDR where
-  decode _ = jpDynamicImageToImage . JP.decodeHDR
 
-instance Array arr YA Double => Readable (Image arr YA Double) HDR where
-  decode _ = jpDynamicImageToImage . JP.decodeHDR
-
-instance Array arr RGB Double => Readable (Image arr RGB Double) HDR where
-  decode _ = jpDynamicImageToImage . JP.decodeHDR
-
-instance Array arr RGBA Double => Readable (Image arr RGBA Double) HDR where
-  decode _ = jpDynamicImageToImage . JP.decodeHDR
-
-
 -- JPG Format Reading
 
-instance Array arr Y Word8 => Readable (Image arr Y Word8) JPG where
+instance Readable (Image VS Y Word8) JPG where
   decode _ = jpImageY8ToImage . JP.decodeJpeg
 
-instance Array arr YA Word8 => Readable (Image arr YA Word8) JPG where
+instance Readable (Image VS YA Word8) JPG where
   decode _ = jpImageYA8ToImage . JP.decodeJpeg
 
-instance Array arr RGB Word8 => Readable (Image arr RGB Word8) JPG where
+instance Readable (Image VS RGB Word8) JPG where
   decode _ = jpImageRGB8ToImage . JP.decodeJpeg
 
-instance Array arr CMYK Word8 => Readable (Image arr CMYK Word8) JPG where
+instance Readable (Image VS CMYK Word8) JPG where
   decode _ = jpImageCMYK8ToImage . JP.decodeJpeg
 
-instance Array arr YCbCr Word8 => Readable (Image arr YCbCr Word8) JPG where
+instance Readable (Image VS YCbCr Word8) JPG where
   decode _ = jpImageYCbCr8ToImage . JP.decodeJpeg
 
-instance Array arr Y Double => Readable (Image arr Y Double) JPG where
-  decode _ = jpDynamicImageToImage . JP.decodeJpeg
 
-instance Array arr YA Double => Readable (Image arr YA Double) JPG where
-  decode _ = jpDynamicImageToImage . JP.decodeJpeg
-
-instance Array arr RGB Double => Readable (Image arr RGB Double) JPG where
-  decode _ = jpDynamicImageToImage . JP.decodeJpeg
-
-instance Array arr RGBA Double => Readable (Image arr RGBA Double) JPG where
-  decode _ = jpDynamicImageToImage . JP.decodeJpeg
-
-
 -- PNG Format Reading
 
-instance (Array arr Y Word8, Array arr Binary Bit) => Readable (Image arr Binary Bit) PNG where
+instance Readable (Image VS Binary Bit) PNG where
   decode _ = fmap toImageBinary . jpImageY8ToImage . JP.decodePng
 
-instance Array arr Y Word8 => Readable (Image arr Y Word8) PNG where
+instance Readable (Image VS Y Word8) PNG where
   decode _ = jpImageY8ToImage . JP.decodePng
 
-instance Array arr Y Word16 => Readable (Image arr Y Word16) PNG where
+instance Readable (Image VS Y Word16) PNG where
   decode _ = jpImageY16ToImage . JP.decodePng
 
-instance Array arr YA Word8 => Readable (Image arr YA Word8) PNG where
+instance Readable (Image VS YA Word8) PNG where
   decode _ = jpImageYA8ToImage . JP.decodePng
 
-instance Array arr YA Word16 => Readable (Image arr YA Word16) PNG where
+instance Readable (Image VS YA Word16) PNG where
   decode _ = jpImageYA16ToImage . JP.decodePng
 
-instance Array arr RGB Word8 => Readable (Image arr RGB Word8) PNG where
+instance Readable (Image VS RGB Word8) PNG where
   decode _ = jpImageRGB8ToImage . JP.decodePng
 
-instance Array arr RGB Word16 => Readable (Image arr RGB Word16) PNG where
+instance Readable (Image VS RGB Word16) PNG where
   decode _ = jpImageRGB16ToImage . JP.decodePng
 
-instance Array arr RGBA Word8 => Readable (Image arr RGBA Word8) PNG where
+instance Readable (Image VS RGBA Word8) PNG where
   decode _ = jpImageRGBA8ToImage . JP.decodePng
 
-instance Array arr RGBA Word16 => Readable (Image arr RGBA Word16) PNG where
+instance Readable (Image VS RGBA Word16) PNG where
   decode _ = jpImageRGBA16ToImage . JP.decodePng
 
-instance Array arr Y Double => Readable (Image arr Y Double) PNG where
-  decode _ = jpDynamicImageToImage . JP.decodePng
 
-instance Array arr YA Double => Readable (Image arr YA Double) PNG where
-  decode _ = jpDynamicImageToImage . JP.decodePng
-
-instance Array arr RGB Double => Readable (Image arr RGB Double) PNG where
-  decode _ = jpDynamicImageToImage . JP.decodePng
-
-instance Array arr RGBA Double => Readable (Image arr RGBA Double) PNG where
-  decode _ = jpDynamicImageToImage . JP.decodePng
-
-
 -- TGA Format Reading
 
-instance (Array arr Y Word8, Array arr Binary Bit) => Readable (Image arr Binary Bit) TGA where
+instance Readable (Image VS Binary Bit) TGA where
   decode _ = fmap toImageBinary . jpImageY8ToImage . JP.decodeTga
 
-instance Array arr Y Word8 => Readable (Image arr Y Word8) TGA where
+instance Readable (Image VS Y Word8) TGA where
   decode _ = jpImageY8ToImage . JP.decodeTga
 
-instance Array arr RGB Word8 => Readable (Image arr RGB Word8) TGA where
+instance Readable (Image VS RGB Word8) TGA where
   decode _ = jpImageRGB8ToImage . JP.decodeTga
 
-instance Array arr RGBA Word8 => Readable (Image arr RGBA Word8) TGA where
+instance Readable (Image VS RGBA Word8) TGA where
   decode _ = jpImageRGBA8ToImage . JP.decodeTga
 
-instance Array arr Y Double => Readable (Image arr Y Double) TGA where
-  decode _ = jpDynamicImageToImage . JP.decodeTga
 
-instance Array arr YA Double => Readable (Image arr YA Double) TGA where
-  decode _ = jpDynamicImageToImage . JP.decodeTga
-
-instance Array arr RGB Double => Readable (Image arr RGB Double) TGA where
-  decode _ = jpDynamicImageToImage . JP.decodeTga
-
-instance Array arr RGBA Double => Readable (Image arr RGBA Double) TGA where
-  decode _ = jpDynamicImageToImage . JP.decodeTga
-
-
 -- TIF Format Reading
 
-instance (Array arr Y Word8, Array arr Binary Bit) => Readable (Image arr Binary Bit) TIF where
+instance Readable (Image VS Binary Bit) TIF where
   decode _ = fmap toImageBinary . jpImageY8ToImage . JP.decodeTiff
 
-instance Array arr Y Word8 => Readable (Image arr Y Word8) TIF where
+instance Readable (Image VS Y Word8) TIF where
   decode _ = jpImageY8ToImage . JP.decodeTiff
 
-instance Array arr Y Word16 => Readable (Image arr Y Word16) TIF where
+instance Readable (Image VS Y Word16) TIF where
   decode _ = jpImageY16ToImage . JP.decodeTiff
 
-instance Array arr YA Word8 => Readable (Image arr YA Word8) TIF where
+instance Readable (Image VS YA Word8) TIF where
   decode _ = jpImageYA8ToImage . JP.decodeTiff
 
-instance Array arr YA Word16 => Readable (Image arr YA Word16) TIF where
+instance Readable (Image VS YA Word16) TIF where
   decode _ = jpImageYA16ToImage . JP.decodeTiff
 
-instance Array arr RGB Word8 => Readable (Image arr RGB Word8) TIF where
+instance Readable (Image VS RGB Word8) TIF where
   decode _ = jpImageRGB8ToImage . JP.decodeTiff
 
-instance Array arr RGB Word16 => Readable (Image arr RGB Word16) TIF where
+instance Readable (Image VS RGB Word16) TIF where
   decode _ = jpImageRGB16ToImage . JP.decodeTiff
 
-instance Array arr RGBA Word8 => Readable (Image arr RGBA Word8) TIF where
+instance Readable (Image VS RGBA Word8) TIF where
   decode _ = jpImageRGBA8ToImage . JP.decodeTiff
 
-instance Array arr RGBA Word16 => Readable (Image arr RGBA Word16) TIF where
+instance Readable (Image VS RGBA Word16) TIF where
   decode _ = jpImageRGBA16ToImage . JP.decodeTiff
 
-instance Array arr CMYK Word8 => Readable (Image arr CMYK Word8) TIF where
+instance Readable (Image VS CMYK Word8) TIF where
   decode _ = jpImageCMYK8ToImage . JP.decodeTiff
 
-instance Array arr CMYK Word16 => Readable (Image arr CMYK Word16) TIF where
+instance Readable (Image VS CMYK Word16) TIF where
   decode _ = jpImageCMYK16ToImage . JP.decodeTiff
 
 
+-- To Double precision safe conversion
+
+instance Array arr Y Double => Readable (Image arr Y Double) BMP where
+  decode _ = jpDynamicImageToImage . JP.decodeBitmap
+
+instance Array arr YA Double => Readable (Image arr YA Double) BMP where
+  decode _ = jpDynamicImageToImage . JP.decodeBitmap
+
+instance Array arr RGB Double => Readable (Image arr RGB Double) BMP where
+  decode _ = jpDynamicImageToImage . JP.decodeBitmap
+
+instance Array arr RGBA Double => Readable (Image arr RGBA Double) BMP where
+  decode _ = jpDynamicImageToImage . JP.decodeBitmap
+
+
+instance Array arr Y Double => Readable (Image arr Y Double) GIF where
+  decode _ = jpDynamicImageToImage . JP.decodeGif
+
+instance Array arr YA Double => Readable (Image arr YA Double) GIF where
+  decode _ = jpDynamicImageToImage . JP.decodeGif
+
+instance Array arr RGB Double => Readable (Image arr RGB Double) GIF where
+  decode _ = jpDynamicImageToImage . JP.decodeGif
+
+instance Array arr RGBA Double => Readable (Image arr RGBA Double) GIF where
+  decode _ = jpDynamicImageToImage . JP.decodeGif
+
+
+instance Array arr Y Double => Readable [Image arr Y Double] [GIF] where
+  decode _ = decodeGifs jpDynamicImageToImage
+
+instance Array arr YA Double => Readable [Image arr YA Double] [GIF] where
+  decode _ = decodeGifs jpDynamicImageToImage
+
+instance Array arr RGB Double => Readable [Image arr RGB Double] [GIF] where
+  decode _ = decodeGifs jpDynamicImageToImage
+
+instance Array arr RGBA Double => Readable [Image arr RGBA Double] [GIF] where
+  decode _ = decodeGifs jpDynamicImageToImage
+
+
+instance Array arr Y Double => Readable (Image arr Y Double) HDR where
+  decode _ = jpDynamicImageToImage . JP.decodeHDR
+
+instance Array arr YA Double => Readable (Image arr YA Double) HDR where
+  decode _ = jpDynamicImageToImage . JP.decodeHDR
+
+instance Array arr RGB Double => Readable (Image arr RGB Double) HDR where
+  decode _ = jpDynamicImageToImage . JP.decodeHDR
+
+instance Array arr RGBA Double => Readable (Image arr RGBA Double) HDR where
+  decode _ = jpDynamicImageToImage . JP.decodeHDR
+
+
+instance Array arr Y Double => Readable (Image arr Y Double) JPG where
+  decode _ = jpDynamicImageToImage . JP.decodeJpeg
+
+instance Array arr YA Double => Readable (Image arr YA Double) JPG where
+  decode _ = jpDynamicImageToImage . JP.decodeJpeg
+
+instance Array arr RGB Double => Readable (Image arr RGB Double) JPG where
+  decode _ = jpDynamicImageToImage . JP.decodeJpeg
+
+instance Array arr RGBA Double => Readable (Image arr RGBA Double) JPG where
+  decode _ = jpDynamicImageToImage . JP.decodeJpeg
+
+
+instance Array arr Y Double => Readable (Image arr Y Double) PNG where
+  decode _ = jpDynamicImageToImage . JP.decodePng
+
+instance Array arr YA Double => Readable (Image arr YA Double) PNG where
+  decode _ = jpDynamicImageToImage . JP.decodePng
+
+instance Array arr RGB Double => Readable (Image arr RGB Double) PNG where
+  decode _ = jpDynamicImageToImage . JP.decodePng
+
+instance Array arr RGBA Double => Readable (Image arr RGBA Double) PNG where
+  decode _ = jpDynamicImageToImage . JP.decodePng
+
+
+instance Array arr Y Double => Readable (Image arr Y Double) TGA where
+  decode _ = jpDynamicImageToImage . JP.decodeTga
+
+instance Array arr YA Double => Readable (Image arr YA Double) TGA where
+  decode _ = jpDynamicImageToImage . JP.decodeTga
+
+instance Array arr RGB Double => Readable (Image arr RGB Double) TGA where
+  decode _ = jpDynamicImageToImage . JP.decodeTga
+
+instance Array arr RGBA Double => Readable (Image arr RGBA Double) TGA where
+  decode _ = jpDynamicImageToImage . JP.decodeTga
+
+
 instance Array arr Y Double => Readable (Image arr Y Double) TIF where
   decode _ = jpDynamicImageToImage . JP.decodeTiff
 
@@ -633,118 +645,111 @@
 
 -- General decoding and helper functions
 
-jpImageToImage :: (Array arr cs e, Convertible jpx (Pixel cs e), JP.Pixel jpx) =>
-                  JP.Image jpx -> Image arr cs e
-jpImageToImage jimg = makeImage (JP.imageHeight jimg, JP.imageWidth jimg) getPx
+jpImageToImageUnsafe :: (Array VS cs e, JP.Pixel jpx) =>
+                  JP.Image jpx -> Image VS cs e
+jpImageToImageUnsafe (JP.Image n m v) = fromStorableVector (m, n) $ V.unsafeCast v
+
+
+
+jpImageToImageSafe :: (Array arr cs e, Convertible jpx (Pixel cs e), JP.Pixel jpx) =>
+                      JP.Image jpx -> Image arr cs e
+jpImageToImageSafe jimg = makeImage (JP.imageHeight jimg, JP.imageWidth jimg) getPx
   where getPx (y, x) = convert $ JP.pixelAt jimg x y
 
 
-jpImageY8ToImage :: Array arr Y Word8 =>
-                    Either String JP.DynamicImage -> Either String (Image arr Y Word8)
-jpImageY8ToImage (Right (JP.ImageY8 jimg)) = Right (jpImageToImage jimg)
+jpImageY8ToImage :: Either String JP.DynamicImage -> Either String (Image VS Y Word8)
+jpImageY8ToImage (Right (JP.ImageY8 jimg)) = Right (jpImageToImageUnsafe jimg)
 jpImageY8ToImage jimg = jpCSError "Y8 (Pixel Y Word8)" jimg
 
 
-jpImageY16ToImage :: Array arr Y Word16 =>
-                     Either String JP.DynamicImage -> Either String (Image arr Y Word16)
-jpImageY16ToImage (Right (JP.ImageY16 jimg)) = Right (jpImageToImage jimg)
+jpImageY16ToImage :: Either String JP.DynamicImage -> Either String (Image VS Y Word16)
+jpImageY16ToImage (Right (JP.ImageY16 jimg)) = Right (jpImageToImageUnsafe jimg)
 jpImageY16ToImage jimg = jpCSError "Y16 (Pixel Y Word16)" jimg
 
 {- -- No JuicyPixels images are actually read in this type
-jpImageYFToImage :: Array arr Y Float =>
-                     Either String JP.DynamicImage -> Either String (Image arr Y Float)
+jpImageYFToImage :: Either String JP.DynamicImage -> Either String (Image VS Y Float)
 jpImageYFToImage (Right (JP.ImageYF jimg)) = Right (jpImageToImage jimg)
 jpImageYFToImage jimg = jpCSError "YF (Pixel Y Float)" jimg
 -}
 
-jpImageYA8ToImage :: Array arr YA Word8 =>
-                    Either String JP.DynamicImage -> Either String (Image arr YA Word8)
-jpImageYA8ToImage (Right (JP.ImageYA8 jimg)) = Right (jpImageToImage jimg)
+jpImageYA8ToImage :: Either String JP.DynamicImage -> Either String (Image VS YA Word8)
+jpImageYA8ToImage (Right (JP.ImageYA8 jimg)) = Right (jpImageToImageUnsafe jimg)
 jpImageYA8ToImage jimg = jpCSError "YA8 (Pixel YA Word8)" jimg
 
 
-jpImageYA16ToImage :: Array arr YA Word16 =>
-                     Either String JP.DynamicImage -> Either String (Image arr YA Word16)
-jpImageYA16ToImage (Right (JP.ImageYA16 jimg)) = Right (jpImageToImage jimg)
+jpImageYA16ToImage :: Either String JP.DynamicImage -> Either String (Image VS YA Word16)
+jpImageYA16ToImage (Right (JP.ImageYA16 jimg)) = Right (jpImageToImageUnsafe jimg)
 jpImageYA16ToImage jimg = jpCSError "YA16 (Pixel YA Word16)" jimg
 
 
-jpImageRGB8ToImage :: Array arr RGB Word8 =>
-                      Either String JP.DynamicImage -> Either String (Image arr RGB Word8)
-jpImageRGB8ToImage (Right (JP.ImageRGB8 jimg)) = Right (jpImageToImage jimg)
+jpImageRGB8ToImage :: Either String JP.DynamicImage -> Either String (Image VS RGB Word8)
+jpImageRGB8ToImage (Right (JP.ImageRGB8 jimg)) = Right (jpImageToImageUnsafe jimg)
 jpImageRGB8ToImage jimg = jpCSError "RGB8 (Pixel RGB Word8)" jimg
 
 
-jpImageRGB16ToImage :: Array arr RGB Word16 =>
-                       Either String JP.DynamicImage -> Either String (Image arr RGB Word16)
-jpImageRGB16ToImage (Right (JP.ImageRGB16 jimg)) = Right (jpImageToImage jimg)
+jpImageRGB16ToImage :: Either String JP.DynamicImage -> Either String (Image VS RGB Word16)
+jpImageRGB16ToImage (Right (JP.ImageRGB16 jimg)) = Right (jpImageToImageUnsafe jimg)
 jpImageRGB16ToImage jimg = jpCSError "RGB16 (Pixel RGB Word16)" jimg
 
 
-jpImageRGBFToImage :: Array arr RGB Float =>
-                       Either String JP.DynamicImage -> Either String (Image arr RGB Float)
-jpImageRGBFToImage (Right (JP.ImageRGBF jimg)) = Right (jpImageToImage jimg)
+jpImageRGBFToImage :: Either String JP.DynamicImage -> Either String (Image VS RGB Float)
+jpImageRGBFToImage (Right (JP.ImageRGBF jimg)) = Right (jpImageToImageUnsafe jimg)
 jpImageRGBFToImage jimg = jpCSError "RGBF (Pixel RGB Float)" jimg
 
 
-jpImageRGBA8ToImage :: Array arr RGBA Word8 =>
-                      Either String JP.DynamicImage -> Either String (Image arr RGBA Word8)
-jpImageRGBA8ToImage (Right (JP.ImageRGBA8 jimg)) = Right (jpImageToImage jimg)
+jpImageRGBA8ToImage :: Either String JP.DynamicImage -> Either String (Image VS RGBA Word8)
+jpImageRGBA8ToImage (Right (JP.ImageRGBA8 jimg)) = Right (jpImageToImageUnsafe jimg)
 jpImageRGBA8ToImage jimg = jpCSError "RGBA8 (Pixel RGBA Word8)" jimg
 
 
-jpImageRGBA16ToImage :: Array arr RGBA Word16 =>
-                       Either String JP.DynamicImage -> Either String (Image arr RGBA Word16)
-jpImageRGBA16ToImage (Right (JP.ImageRGBA16 jimg)) = Right (jpImageToImage jimg)
+jpImageRGBA16ToImage :: Either String JP.DynamicImage -> Either String (Image VS RGBA Word16)
+jpImageRGBA16ToImage (Right (JP.ImageRGBA16 jimg)) = Right (jpImageToImageUnsafe jimg)
 jpImageRGBA16ToImage jimg = jpCSError "RGBA16 (Pixel RGBA Word16)" jimg
 
 
-jpImageYCbCr8ToImage :: Array arr YCbCr Word8 =>
-                      Either String JP.DynamicImage -> Either String (Image arr YCbCr Word8)
-jpImageYCbCr8ToImage (Right (JP.ImageYCbCr8 jimg)) = Right (jpImageToImage jimg)
+jpImageYCbCr8ToImage :: Either String JP.DynamicImage -> Either String (Image VS YCbCr Word8)
+jpImageYCbCr8ToImage (Right (JP.ImageYCbCr8 jimg)) = Right (jpImageToImageUnsafe jimg)
 jpImageYCbCr8ToImage jimg = jpCSError "YCbCr8 (Pixel YCbCr Word8)" jimg
 
 
-jpImageCMYK8ToImage :: Array arr CMYK Word8 =>
-                      Either String JP.DynamicImage -> Either String (Image arr CMYK Word8)
-jpImageCMYK8ToImage (Right (JP.ImageCMYK8 jimg)) = Right (jpImageToImage jimg)
+jpImageCMYK8ToImage :: Either String JP.DynamicImage -> Either String (Image VS CMYK Word8)
+jpImageCMYK8ToImage (Right (JP.ImageCMYK8 jimg)) = Right (jpImageToImageUnsafe jimg)
 jpImageCMYK8ToImage jimg = jpCSError "CMYK8 (Pixel CMYK Word8)" jimg
 
 
-jpImageCMYK16ToImage :: Array arr CMYK Word16 =>
-                      Either String JP.DynamicImage -> Either String (Image arr CMYK Word16)
-jpImageCMYK16ToImage (Right (JP.ImageCMYK16 jimg)) = Right (jpImageToImage jimg)
+jpImageCMYK16ToImage :: Either String JP.DynamicImage -> Either String (Image VS CMYK Word16)
+jpImageCMYK16ToImage (Right (JP.ImageCMYK16 jimg)) = Right (jpImageToImageUnsafe jimg)
 jpImageCMYK16ToImage jimg = jpCSError "CMYK16 (Pixel CMYK Word16)" jimg
 
 
 jpDynamicImageToImage' :: (Convertible JP.PixelCMYK16 (Pixel cs e),
-                          Convertible JP.PixelCMYK8 (Pixel cs e),
-                          Convertible JP.PixelRGB16 (Pixel cs e),
-                          Convertible JP.PixelRGB8 (Pixel cs e),
-                          Convertible JP.PixelRGBA16 (Pixel cs e),
-                          Convertible JP.PixelRGBA8 (Pixel cs e),
-                          Convertible JP.PixelRGBF (Pixel cs e),
-                          Convertible JP.PixelYA16 (Pixel cs e),
-                          Convertible JP.PixelYA8 (Pixel cs e),
-                          Convertible JP.PixelYCbCr8 (Pixel cs e),
-                          Convertible JP.Pixel16 (Pixel cs e),
-                          Convertible JP.Pixel8 (Pixel cs e),
-                          Convertible JP.PixelF (Pixel cs e),
-                          Array arr cs e) =>
-                         JP.DynamicImage -> Image arr cs e
-jpDynamicImageToImage' (JP.ImageY8 jimg)     = jpImageToImage jimg
-jpDynamicImageToImage' (JP.ImageY16 jimg)    = jpImageToImage jimg
-jpDynamicImageToImage' (JP.ImageYF jimg)     = jpImageToImage jimg
-jpDynamicImageToImage' (JP.ImageYA8 jimg)    = jpImageToImage jimg
-jpDynamicImageToImage' (JP.ImageYA16 jimg)   = jpImageToImage jimg
-jpDynamicImageToImage' (JP.ImageRGB8 jimg)   = jpImageToImage jimg
-jpDynamicImageToImage' (JP.ImageRGB16 jimg)  = jpImageToImage jimg
-jpDynamicImageToImage' (JP.ImageRGBF jimg)   = jpImageToImage jimg
-jpDynamicImageToImage' (JP.ImageRGBA8 jimg)  = jpImageToImage jimg
-jpDynamicImageToImage' (JP.ImageRGBA16 jimg) = jpImageToImage jimg
-jpDynamicImageToImage' (JP.ImageYCbCr8 jimg) = jpImageToImage jimg
-jpDynamicImageToImage' (JP.ImageCMYK8 jimg)  = jpImageToImage jimg
-jpDynamicImageToImage' (JP.ImageCMYK16 jimg) = jpImageToImage jimg
+                           Convertible JP.PixelCMYK8 (Pixel cs e),
+                           Convertible JP.PixelRGB16 (Pixel cs e),
+                           Convertible JP.PixelRGB8 (Pixel cs e),
+                           Convertible JP.PixelRGBA16 (Pixel cs e),
+                           Convertible JP.PixelRGBA8 (Pixel cs e),
+                           Convertible JP.PixelRGBF (Pixel cs e),
+                           Convertible JP.PixelYA16 (Pixel cs e),
+                           Convertible JP.PixelYA8 (Pixel cs e),
+                           Convertible JP.PixelYCbCr8 (Pixel cs e),
+                           Convertible JP.Pixel16 (Pixel cs e),
+                           Convertible JP.Pixel8 (Pixel cs e),
+                           Convertible JP.PixelF (Pixel cs e),
+                           Array arr cs e) =>
+                          JP.DynamicImage -> Image arr cs e
+jpDynamicImageToImage' (JP.ImageY8 jimg)     = jpImageToImageSafe jimg
+jpDynamicImageToImage' (JP.ImageY16 jimg)    = jpImageToImageSafe jimg
+jpDynamicImageToImage' (JP.ImageYF jimg)     = jpImageToImageSafe jimg
+jpDynamicImageToImage' (JP.ImageYA8 jimg)    = jpImageToImageSafe jimg
+jpDynamicImageToImage' (JP.ImageYA16 jimg)   = jpImageToImageSafe jimg
+jpDynamicImageToImage' (JP.ImageRGB8 jimg)   = jpImageToImageSafe jimg
+jpDynamicImageToImage' (JP.ImageRGB16 jimg)  = jpImageToImageSafe jimg
+jpDynamicImageToImage' (JP.ImageRGBF jimg)   = jpImageToImageSafe jimg
+jpDynamicImageToImage' (JP.ImageRGBA8 jimg)  = jpImageToImageSafe jimg
+jpDynamicImageToImage' (JP.ImageRGBA16 jimg) = jpImageToImageSafe jimg
+jpDynamicImageToImage' (JP.ImageYCbCr8 jimg) = jpImageToImageSafe jimg
+jpDynamicImageToImage' (JP.ImageCMYK8 jimg)  = jpImageToImageSafe jimg
+jpDynamicImageToImage' (JP.ImageCMYK16 jimg) = jpImageToImageSafe jimg
 
 
 jpDynamicImageToImage :: (Convertible JP.PixelCMYK16 (Pixel cs e),
@@ -796,73 +801,65 @@
 -- Encoding images using JuicyPixels -------------------------------------------
 --------------------------------------------------------------------------------
 
-instance Array arr Y Word8 => Writable (Image arr Y Word8) BMP where
-  encode _ _ = JP.encodeBitmap . imageToJPImage (convert :: Pixel Y Word8 -> JP.Pixel8) 
+instance Writable (Image VS Y Word8) BMP where
+  encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.Pixel8) id
 
-instance Array arr RGB Word8 => Writable (Image arr RGB Word8) BMP where
-  encode _ _ = JP.encodeBitmap . imageToJPImage (convert :: Pixel RGB Word8 -> JP.PixelRGB8) 
+instance Writable (Image VS RGB Word8) BMP where
+  encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.PixelRGB8) id
 
-instance Array arr RGBA Word8 => Writable (Image arr RGBA Word8) BMP where
-  encode _ _ = JP.encodeBitmap . imageToJPImage (convert :: Pixel RGBA Word8 -> JP.PixelRGBA8) 
+instance Writable (Image VS RGBA Word8) BMP where
+  encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.PixelRGBA8) id
 
-instance Array arr Binary Bit => Writable (Image arr Binary Bit) BMP where
-  encode _ _ = JP.encodeBitmap . imageToJPImage ((convert :: Pixel Y Word8 -> JP.Pixel8)
-                                                 . fromPixelBinary)
+instance Writable (Image VS Binary Bit) BMP where
+  encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.Pixel8) fromPixelBinary
 
-instance Array arr Y Double => Writable (Image arr Y Double) BMP where
-  encode _ _ = JP.encodeBitmap . imageToJPImage ((convert :: Pixel Y Word8 -> JP.Pixel8)
-                                                 . toWord8)
+instance Writable (Image VS Y Double) BMP where
+  encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.Pixel8) (fmap toWord8)
 
-instance Array arr YA Double => Writable (Image arr YA Double) BMP where
-  encode _ _ = JP.encodeBitmap . imageToJPImage ((convert :: Pixel Y Word8 -> JP.Pixel8)
-                                                 . toWord8 . dropAlpha)
+instance Writable (Image VS YA Double) BMP where
+  encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.Pixel8)
+                                                ((fmap toWord8) . dropAlpha)
 
-instance Array arr RGB Double => Writable (Image arr RGB Double) BMP where
-  encode _ _ = JP.encodeBitmap . imageToJPImage ((convert :: Pixel RGB Word8 -> JP.PixelRGB8)
-                                                 . toWord8)
+instance Writable (Image VS RGB Double) BMP where
+  encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.PixelRGB8) (fmap toWord8)
 
-instance Array arr RGBA Double => Writable (Image arr RGBA Double) BMP where
-  encode _ _ = JP.encodeBitmap . imageToJPImage ((convert :: Pixel RGBA Word8 -> JP.PixelRGBA8)
-                                                 . toWord8)
+instance Writable (Image VS RGBA Double) BMP where
+  encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.PixelRGBA8) (fmap toWord8)
 
 -- Writable GIF
 
-encodeGIF :: Array arr cs e =>
-             [SaveOption GIF] -> (Pixel cs e -> JP.PixelRGB8)
-             -> Image arr cs e -> BL.ByteString
+encodeGIF :: (Array VS cs' e, Array VS cs Word8) =>
+             [SaveOption GIF] -> (Pixel cs' e -> Pixel cs Word8)
+             -> Image VS cs' e -> BL.ByteString
 encodeGIF []                     !conv =
   either error id . uncurry JP.encodeGifImageWithPalette .
-  JP.palettize JP.defaultPaletteOptions . imageToJPImage conv
+  JP.palettize JP.defaultPaletteOptions . imageToJPImage (undefined :: JP.PixelRGB8) conv
 encodeGIF (GIFPalette palOpts:_) !conv =
   either error id . uncurry JP.encodeGifImageWithPalette .
-  JP.palettize palOpts . imageToJPImage conv
+  JP.palettize palOpts . imageToJPImage (undefined :: JP.PixelRGB8) conv
 
 
-instance Array arr RGB Word8 => Writable (Image arr RGB Word8) GIF where
-  encode _ opts = encodeGIF opts (convert :: Pixel RGB Word8 -> JP.PixelRGB8)
+instance Writable (Image VS RGB Word8) GIF where
+  encode _ opts = encodeGIF opts id
   
-instance Array arr Y Double => Writable (Image arr Y Double) GIF where
-  encode _ opts = encodeGIF opts ((convert :: Pixel RGB Word8 -> JP.PixelRGB8)
-                                  . toWord8 . toPixelRGB)
+instance Writable (Image VS Y Double) GIF where
+  encode _ opts = encodeGIF opts ((fmap toWord8) . toPixelRGB)
     
-instance Array arr YA Double => Writable (Image arr YA Double) GIF where
-  encode _ opts = encodeGIF opts ((convert :: Pixel RGB Word8 -> JP.PixelRGB8)
-                                  . toWord8 . toPixelRGB . dropAlpha)
+instance Writable (Image VS YA Double) GIF where
+  encode _ opts = encodeGIF opts ((fmap toWord8) . toPixelRGB . dropAlpha)
 
-instance Array arr RGB Double => Writable (Image arr RGB Double) GIF where
-  encode _ opts = encodeGIF opts ((convert :: Pixel RGB Word8 -> JP.PixelRGB8)
-                                  . toWord8)
+instance Writable (Image VS RGB Double) GIF where
+  encode _ opts = encodeGIF opts (fmap toWord8)
 
-instance Array arr RGBA Double => Writable (Image arr RGBA Double) GIF where
-  encode _ opts = encodeGIF opts ((convert :: Pixel RGB Word8 -> JP.PixelRGB8)
-                                  . toWord8 . dropAlpha)
+instance Writable (Image VS RGBA Double) GIF where
+  encode _ opts = encodeGIF opts ((fmap toWord8) . dropAlpha)
 
 
-encodeGIFs :: Array arr cs e =>
-              [SaveOption [GIF]] -> (Pixel cs e -> JP.PixelRGB8)
-           -> [(JP.GifDelay, Image arr cs e)] -> BL.ByteString
+encodeGIFs :: (Array VS cs' e, Array VS cs Word8) =>
+              [SaveOption [GIF]] -> (Pixel cs' e -> Pixel cs Word8)
+           -> [(JP.GifDelay, Image VS cs' e)] -> BL.ByteString
 encodeGIFs !opts !conv =
-  either error id . JP.encodeGifImages (getGIFsLoop opts) . map palletizeGif where
+  either error id . JP.encodeGifImages (getGIFsLoop opts) . P.map palletizeGif where
     getGIFsLoop []                   = JP.LoopingNever
     getGIFsLoop (GIFsLooping loop:_) = loop
     getGIFsLoop (_:xs)               = getGIFsLoop xs    
@@ -870,231 +867,209 @@
     getGIFsPal (GIFsPalette palOpts:_) = palOpts
     getGIFsPal (_:xs)                  = getGIFsPal xs
     palletizeGif !(d, img) = (p, d, jimg) where  
-      !(jimg, p) = JP.palettize (getGIFsPal opts) $ imageToJPImage conv img
+      !(jimg, p) = JP.palettize (getGIFsPal opts) $
+                   imageToJPImage (undefined :: JP.PixelRGB8) conv img
 
 
-instance Array arr RGB Word8 => Writable [(JP.GifDelay, Image arr RGB Word8)] [GIF] where
-  encode _ opts = encodeGIFs opts (convert :: Pixel RGB Word8 -> JP.PixelRGB8)
-
-instance Array arr RGB Double => Writable [(JP.GifDelay, Image arr RGB Double)] [GIF] where
-  encode _ opts = encodeGIFs opts ((convert :: Pixel RGB Word8 -> JP.PixelRGB8)
-                                   . toWord8)
+instance Writable [(JP.GifDelay, Image VS RGB Word8)] [GIF] where
+  encode _ opts = encodeGIFs opts id
 
+instance Writable [(JP.GifDelay, Image VS RGB Double)] [GIF] where
+  encode _ opts = encodeGIFs opts (fmap toWord8)
 -- Writable HDR
 
-instance Array arr RGB Float => Writable (Image arr RGB Float) HDR where
-  encode _ _ = JP.encodeHDR . imageToJPImage (convert :: Pixel RGB Float -> JP.PixelRGBF) 
+instance Writable (Image VS RGB Float) HDR where
+  encode _ _ = JP.encodeHDR . imageToJPImage (undefined :: JP.PixelRGBF) id
 
-instance Array arr Y Double => Writable (Image arr Y Double) HDR where
-  encode _ _ = JP.encodeHDR . imageToJPImage ((convert :: Pixel RGB Float -> JP.PixelRGBF)
-                                              . toFloat . toPixelRGB)
+instance Writable (Image VS Y Double) HDR where
+  encode _ _ = JP.encodeHDR . imageToJPImage (undefined :: JP.PixelRGBF)
+                                             (fmap toFloat . toPixelRGB)
 
-instance Array arr YA Double => Writable (Image arr YA Double) HDR where
-  encode _ _ = JP.encodeHDR . imageToJPImage ((convert :: Pixel RGB Float -> JP.PixelRGBF)
-                                              . toFloat . toPixelRGB . dropAlpha)
+instance Writable (Image VS YA Double) HDR where
+  encode _ _ = JP.encodeHDR . imageToJPImage (undefined :: JP.PixelRGBF)
+                                             (fmap toFloat . toPixelRGB . dropAlpha)
 
-instance Array arr RGB Double => Writable (Image arr RGB Double) HDR where
-  encode _ _ = JP.encodeHDR . imageToJPImage ((convert :: Pixel RGB Float -> JP.PixelRGBF)
-                                              . toFloat)
+instance Writable (Image VS RGB Double) HDR where
+  encode _ _ = JP.encodeHDR . imageToJPImage (undefined :: JP.PixelRGBF) (fmap toFloat)
 
-instance Array arr RGBA Double => Writable (Image arr RGBA Double) HDR where
-  encode _ _ = JP.encodeHDR . imageToJPImage ((convert :: Pixel RGB Float -> JP.PixelRGBF)
-                                              . toFloat . dropAlpha)
+instance Writable (Image VS RGBA Double) HDR where
+  encode _ _ = JP.encodeHDR . imageToJPImage (undefined :: JP.PixelRGBF)
+                                             (fmap toFloat . dropAlpha)
  
 
 -- Writable JPG
 
 
-encodeJPG :: (JP.JpgEncodable px, Array arr cs e) =>
-             [SaveOption JPG] -> (Pixel cs e -> px) -> Image arr cs e -> BL.ByteString
-encodeJPG []               conv =
-  JP.encodeDirectJpegAtQualityWithMetadata 100 M.mempty . imageToJPImage conv
-encodeJPG (JPGQuality q:_) conv =
-  JP.encodeDirectJpegAtQualityWithMetadata q M.mempty . imageToJPImage conv
+encodeJPG
+  :: (JP.JpgEncodable px, Array VS cs' e, Array VS cs (JP.PixelBaseComponent px)) =>
+     [SaveOption JPG]
+     -> px
+     -> (Pixel cs' e -> Pixel cs (JP.PixelBaseComponent px))
+     -> Image VS cs' e
+     -> BL.ByteString
+encodeJPG []               t conv =
+  JP.encodeDirectJpegAtQualityWithMetadata 100 M.mempty . imageToJPImage t conv
+encodeJPG (JPGQuality q:_) t conv =
+  JP.encodeDirectJpegAtQualityWithMetadata q M.mempty . imageToJPImage t conv
 
 
-instance Array arr Y Word8 => Writable (Image arr Y Word8) JPG where
-  encode _ opts = encodeJPG opts (convert :: Pixel Y Word8 -> JP.Pixel8)
+instance Writable (Image VS Y Word8) JPG where
+  encode _ opts = encodeJPG opts (undefined :: JP.Pixel8) id
 
-instance Array arr RGB Word8 => Writable (Image arr RGB Word8) JPG where
-  encode _ opts = encodeJPG opts (convert :: Pixel RGB Word8 -> JP.PixelRGB8) 
+instance Writable (Image VS RGB Word8) JPG where
+  encode _ opts = encodeJPG opts (undefined :: JP.PixelRGB8) id
 
-instance Array arr CMYK Word8 => Writable (Image arr CMYK Word8) JPG where
-  encode _ opts = encodeJPG opts (convert :: Pixel CMYK Word8 -> JP.PixelCMYK8) 
+instance Writable (Image VS CMYK Word8) JPG where
+  encode _ opts = encodeJPG opts (undefined :: JP.PixelCMYK8) id
                
-instance Array arr YCbCr Word8 => Writable (Image arr YCbCr Word8) JPG where
-  encode _ opts = encodeJPG opts (convert :: Pixel YCbCr Word8 -> JP.PixelYCbCr8) 
+instance Writable (Image VS YCbCr Word8) JPG where
+  encode _ opts = encodeJPG opts (undefined :: JP.PixelYCbCr8) id
 
-instance Array arr Y Double => Writable (Image arr Y Double) JPG where
-  encode _ opts = encodeJPG opts ((convert :: Pixel Y Word8 -> JP.Pixel8)
-                                  . toWord8) 
+instance Writable (Image VS Y Double) JPG where
+  encode _ opts = encodeJPG opts (undefined :: JP.Pixel8) (fmap toWord8)
 
-instance Array arr YA Double => Writable (Image arr YA Double) JPG where
-  encode _ opts = encodeJPG opts ((convert :: Pixel Y Word8 -> JP.Pixel8)
-                                  . toWord8 . dropAlpha) 
+instance Writable (Image VS YA Double) JPG where
+  encode _ opts = encodeJPG opts (undefined :: JP.Pixel8) ((fmap toWord8) . dropAlpha) 
 
-instance Array arr RGB Double => Writable (Image arr RGB Double) JPG where
-  encode _ opts = encodeJPG opts ((convert :: Pixel RGB Word8 -> JP.PixelRGB8)
-                                  . toWord8) 
+instance Writable (Image VS RGB Double) JPG where
+  encode _ opts = encodeJPG opts (undefined :: JP.PixelRGB8) (fmap toWord8)
 
-instance Array arr RGBA Double => Writable (Image arr RGBA Double) JPG where
-  encode _ opts = encodeJPG opts ((convert :: Pixel RGB Word8 -> JP.PixelRGB8)
-                                  . toWord8 . dropAlpha) 
+instance Writable (Image VS RGBA Double) JPG where
+  encode _ opts = encodeJPG opts (undefined :: JP.PixelRGB8) ((fmap toWord8) . dropAlpha) 
 
 
 -- Writable PNG
 
-instance Array arr Binary Bit => Writable (Image arr Binary Bit) PNG where
-  encode _ _ = JP.encodePng . imageToJPImage ((convert :: Pixel Y Word8 -> JP.Pixel8) 
-                                              . fromPixelBinary)
+instance Writable (Image VS Binary Bit) PNG where
+  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.Pixel8) fromPixelBinary
   
-instance Array arr Y Word8 => Writable (Image arr Y Word8) PNG where
-  encode _ _ = JP.encodePng . imageToJPImage (convert :: Pixel Y Word8 -> JP.Pixel8) 
+instance Writable (Image VS Y Word8) PNG where
+  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.Pixel8) id
 
-instance Array arr Y Word16 => Writable (Image arr Y Word16) PNG where
-  encode _ _ = JP.encodePng . imageToJPImage (convert :: Pixel Y Word16 -> JP.Pixel16) 
+instance Writable (Image VS Y Word16) PNG where
+  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.Pixel16) id
 
-instance Array arr YA Word8 => Writable (Image arr YA Word8) PNG where
-  encode _ _ = JP.encodePng . imageToJPImage (convert :: Pixel YA Word8 -> JP.PixelYA8) 
+instance Writable (Image VS YA Word8) PNG where
+  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelYA8) id
 
-instance Array arr YA Word16 => Writable (Image arr YA Word16) PNG where
-  encode _ _ = JP.encodePng . imageToJPImage (convert :: Pixel YA Word16 -> JP.PixelYA16) 
+instance Writable (Image VS YA Word16) PNG where
+  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelYA16) id
 
-instance Array arr RGB Word8 => Writable (Image arr RGB Word8) PNG where
-  encode _ _ = JP.encodePng . imageToJPImage (convert :: Pixel RGB Word8 -> JP.PixelRGB8) 
+instance Writable (Image VS RGB Word8) PNG where
+  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelRGB8) id
 
-instance Array arr RGB Word16 => Writable (Image arr RGB Word16) PNG where
-  encode _ _ = JP.encodePng . imageToJPImage (convert :: Pixel RGB Word16 -> JP.PixelRGB16) 
+instance Writable (Image VS RGB Word16) PNG where
+  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelRGB16) id
 
-instance Array arr RGBA Word8 => Writable (Image arr RGBA Word8) PNG where
-  encode _ _ = JP.encodePng . imageToJPImage (convert :: Pixel RGBA Word8 -> JP.PixelRGBA8) 
+instance Writable (Image VS RGBA Word8) PNG where
+  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelRGBA8) id
 
-instance Array arr RGBA Word16 => Writable (Image arr RGBA Word16) PNG where
-  encode _ _ = JP.encodePng . imageToJPImage (convert :: Pixel RGBA Word16 -> JP.PixelRGBA16) 
+instance Writable (Image VS RGBA Word16) PNG where
+  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelRGBA16) id
 
 
-instance Array arr Y Double => Writable (Image arr Y Double) PNG where
-  encode _ _ = JP.encodePng . imageToJPImage ((convert :: Pixel Y Word16 -> JP.Pixel16)
-                                              . toWord16)
+instance Writable (Image VS Y Double) PNG where
+  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.Pixel16) (fmap toWord16)
 
-instance Array arr YA Double => Writable (Image arr YA Double) PNG where
-  encode _ _ = JP.encodePng . imageToJPImage ((convert :: Pixel YA Word16 -> JP.PixelYA16)
-                                              . toWord16)
+instance Writable (Image VS YA Double) PNG where
+  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelYA16) (fmap toWord16)
 
-instance Array arr RGB Double => Writable (Image arr RGB Double) PNG where
-  encode _ _ = JP.encodePng . imageToJPImage ((convert :: Pixel RGB Word16 -> JP.PixelRGB16)
-                                              . toWord16)
+instance Writable (Image VS RGB Double) PNG where
+  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelRGB16) (fmap toWord16)
 
-instance Array arr RGBA Double => Writable (Image arr RGBA Double) PNG where
-  encode _ _ = JP.encodePng . imageToJPImage ((convert :: Pixel RGBA Word16 -> JP.PixelRGBA16)
-                                              . toWord16)
+instance Writable (Image VS RGBA Double) PNG where
+  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelRGBA16) (fmap toWord16)
 
 -- Writable TGA
 
-instance Array arr Binary Bit => Writable (Image arr Binary Bit) TGA where
-  encode _ _ = JP.encodeTga . imageToJPImage ((convert :: Pixel Y Word8 -> JP.Pixel8)
-                                              . fromPixelBinary)
+instance Writable (Image VS Binary Bit) TGA where
+  encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.Pixel8) fromPixelBinary
   
-instance Array arr Y Word8 => Writable (Image arr Y Word8) TGA where
-  encode _ _ = JP.encodeTga . imageToJPImage (convert :: Pixel Y Word8 -> JP.Pixel8) 
+instance Writable (Image VS Y Word8) TGA where
+  encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.Pixel8) id
 
-instance Array arr RGB Word8 => Writable (Image arr RGB Word8) TGA where
-  encode _ _ = JP.encodeTga . imageToJPImage (convert :: Pixel RGB Word8 -> JP.PixelRGB8) 
+instance Writable (Image VS RGB Word8) TGA where
+  encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.PixelRGB8) id
 
-instance Array arr RGBA Word8 => Writable (Image arr RGBA Word8) TGA where
-  encode _ _ = JP.encodeTga . imageToJPImage (convert :: Pixel RGBA Word8 -> JP.PixelRGBA8) 
+instance Writable (Image VS RGBA Word8) TGA where
+  encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.PixelRGBA8) id
 
 
-instance Array arr Y Double => Writable (Image arr Y Double) TGA where
-  encode _ _ = JP.encodeTga . imageToJPImage ((convert :: Pixel Y Word8 -> JP.Pixel8)
-                                              . toWord8)
+instance Writable (Image VS Y Double) TGA where
+  encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.Pixel8) (fmap toWord8)
 
-instance Array arr YA Double => Writable (Image arr YA Double) TGA where
-  encode _ _ = JP.encodeTga . imageToJPImage ((convert :: Pixel Y Word8 -> JP.Pixel8)
-                                              . toWord8 . dropAlpha)
+instance Writable (Image VS YA Double) TGA where
+  encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.Pixel8) ((fmap toWord8) . dropAlpha)
 
-instance Array arr RGB Double => Writable (Image arr RGB Double) TGA where
-  encode _ _ = JP.encodeTga . imageToJPImage ((convert :: Pixel RGB Word8 -> JP.PixelRGB8)
-                                              . toWord8)
+instance Writable (Image VS RGB Double) TGA where
+  encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.PixelRGB8) (fmap toWord8)
 
-instance Array arr RGBA Double => Writable (Image arr RGBA Double) TGA where
-  encode _ _ = JP.encodeTga . imageToJPImage ((convert :: Pixel RGBA Word8 -> JP.PixelRGBA8)
-                                              . toWord8)
+instance Writable (Image VS RGBA Double) TGA where
+  encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.PixelRGBA8) (fmap toWord8)
 
 -- Writable TIF
 
-instance Array arr Y Word8 => Writable (Image arr Y Word8) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage (convert :: Pixel Y Word8 -> JP.Pixel8) 
+instance Writable (Image VS Y Word8) TIF where
+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.Pixel8) id
 
-instance Array arr Y Word16 => Writable (Image arr Y Word16) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage (convert :: Pixel Y Word16 -> JP.Pixel16) 
+instance Writable (Image VS Y Word16) TIF where
+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.Pixel16) id
 
-instance Array arr YA Word8 => Writable (Image arr YA Word8) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage (convert :: Pixel YA Word8 -> JP.PixelYA8) 
+instance Writable (Image VS YA Word8) TIF where
+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelYA8) id
 
-instance Array arr YA Word16 => Writable (Image arr YA Word16) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage (convert :: Pixel YA Word16 -> JP.PixelYA16) 
+instance Writable (Image VS YA Word16) TIF where
+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelYA16) id
 
-instance Array arr RGB Word8 => Writable (Image arr RGB Word8) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage (convert :: Pixel RGB Word8 -> JP.PixelRGB8) 
+instance Writable (Image VS RGB Word8) TIF where
+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelRGB8) id
 
-instance Array arr RGB Word16 => Writable (Image arr RGB Word16) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage (convert :: Pixel RGB Word16 -> JP.PixelRGB16) 
+instance Writable (Image VS RGB Word16) TIF where
+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelRGB16) id
 
-instance Array arr RGBA Word8 => Writable (Image arr RGBA Word8) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage (convert :: Pixel RGBA Word8 -> JP.PixelRGBA8) 
+instance Writable (Image VS RGBA Word8) TIF where
+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelRGBA8) id
 
-instance Array arr RGBA Word16 => Writable (Image arr RGBA Word16) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage (convert :: Pixel RGBA Word16 -> JP.PixelRGBA16) 
+instance Writable (Image VS RGBA Word16) TIF where
+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelRGBA16) id
 
-instance Array arr YCbCr Word8 => Writable (Image arr YCbCr Word8) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage (convert :: Pixel YCbCr Word8 -> JP.PixelYCbCr8)
+instance Writable (Image VS YCbCr Word8) TIF where
+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelYCbCr8) id
   
-instance Array arr CMYK Word8 => Writable (Image arr CMYK Word8) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage (convert :: Pixel CMYK Word8 -> JP.PixelCMYK8) 
+instance Writable (Image VS CMYK Word8) TIF where
+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelCMYK8) id
 
-instance Array arr CMYK Word16 => Writable (Image arr CMYK Word16) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage (convert :: Pixel CMYK Word16 -> JP.PixelCMYK16) 
+instance Writable (Image VS CMYK Word16) TIF where
+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelCMYK16) id
 
 
-instance Array arr Binary Bit => Writable (Image arr Binary Bit) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage ((convert :: Pixel Y Word8 -> JP.Pixel8)
-                                               . fromPixelBinary)
+instance Writable (Image VS Binary Bit) TIF where
+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.Pixel8) fromPixelBinary
   
-instance Array arr Y Double => Writable (Image arr Y Double) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage ((convert :: Pixel Y Word16 -> JP.Pixel16)
-                                               . toWord16)
+instance Writable (Image VS Y Double) TIF where
+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.Pixel16) (fmap toWord16)
 
-instance Array arr YA Double => Writable (Image arr YA Double) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage ((convert :: Pixel YA Word16 -> JP.PixelYA16)
-                                               . toWord16)
+instance Writable (Image VS YA Double) TIF where
+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelYA16) (fmap toWord16)
 
-instance Array arr RGB Double => Writable (Image arr RGB Double) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage ((convert :: Pixel RGB Word16 -> JP.PixelRGB16)
-                                               . toWord16)
+instance Writable (Image VS RGB Double) TIF where
+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelRGB16) (fmap toWord16)
 
-instance Array arr RGBA Double => Writable (Image arr RGBA Double) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage ((convert :: Pixel RGBA Word16 -> JP.PixelRGBA16)
-                                               . toWord16)
+instance Writable (Image VS RGBA Double) TIF where
+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelRGBA16) (fmap toWord16)
 
-instance Array arr YCbCr Double => Writable (Image arr YCbCr Double) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage ((convert :: Pixel YCbCr Word8 -> JP.PixelYCbCr8)
-                                               . toWord8)
+instance Writable (Image VS YCbCr Double) TIF where
+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelYCbCr8) (fmap toWord8)
 
-instance Array arr CMYK Double => Writable (Image arr CMYK Double) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage ((convert :: Pixel CMYK Word16 -> JP.PixelCMYK16)
-                                               . toWord16)
+instance Writable (Image VS CMYK Double) TIF where
+  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelCMYK16) (fmap toWord16)
 
 
 
-imageToJPImage :: (JP.Pixel a, Array arr cs e) =>
-                  (Pixel cs e -> a) -> Image arr cs e -> JP.Image a
-imageToJPImage !f !imgD = JP.generateImage g n m
-  where
-    !(m, n) = dims imgD
-    !img = toManifest imgD
-    g !j !i = f (index img (i, j))
-    {-# INLINE g #-}
+imageToJPImage :: (JP.Pixel a, Array VS cs' e, Array VS cs (JP.PixelBaseComponent a)) =>
+                  a -> (Pixel cs' e -> Pixel cs (JP.PixelBaseComponent a)) -> Image VS cs' e -> JP.Image a
+imageToJPImage _ f !img = JP.Image n m $ V.unsafeCast $ toStorableVector $ I.map f img where
+  !(m, n) = dims img
 {-# INLINE imageToJPImage #-}
 
 
diff --git a/src/Graphics/Image/IO/Formats/Netpbm.hs b/src/Graphics/Image/IO/Formats/Netpbm.hs
--- a/src/Graphics/Image/IO/Formats/Netpbm.hs
+++ b/src/Graphics/Image/IO/Formats/Netpbm.hs
@@ -18,11 +18,12 @@
 
 import Graphics.Image.ColorSpace
 import Graphics.Image.Interface hiding (map)
+import Graphics.Image.Interface.Vector
 import Graphics.Image.IO.Base
 import Foreign.Storable (Storable)
 import qualified Data.ByteString as B (ByteString)
 import qualified Graphics.Netpbm as PNM
-import qualified Data.Vector.Storable as VS ((!), Vector)
+import qualified Data.Vector.Storable as V
 
 
 -- | Netpbm: portable bitmap image with @.pbm@ extension.
@@ -80,16 +81,16 @@
   convert (PNM.PbmPixel bool) = PixelY $ if bool then 0 else 1
   
 instance Convertible PNM.PgmPixel8 (Pixel Y Double) where
-  convert (PNM.PgmPixel8 w8) = toDouble . PixelY $ w8
+  convert (PNM.PgmPixel8 w8) = PixelY $ toDouble w8
 
 instance Convertible PNM.PgmPixel16 (Pixel Y Double) where
-  convert (PNM.PgmPixel16 w16) = toDouble . PixelY $ w16
+  convert (PNM.PgmPixel16 w16) = PixelY $ toDouble w16
 
 instance Convertible PNM.PpmPixelRGB8 (Pixel Y Double) where
-  convert (PNM.PpmPixelRGB8 r g b) = toPixelY . toDouble $ PixelRGB r g b
+  convert (PNM.PpmPixelRGB8 r g b) = toPixelY . fmap toDouble $ PixelRGB r g b
 
 instance Convertible PNM.PpmPixelRGB16 (Pixel Y Double) where
-  convert (PNM.PpmPixelRGB16 r g b) = toPixelY . toDouble $ PixelRGB r g b
+  convert (PNM.PpmPixelRGB16 r g b) = toPixelY . fmap toDouble $ PixelRGB r g b
 
 -- -> YA (Double)
 
@@ -120,10 +121,10 @@
   convert = toPixelRGB . (convert :: PNM.PgmPixel16 -> Pixel Y Double)
 
 instance Convertible PNM.PpmPixelRGB8 (Pixel RGB Double) where
-  convert (PNM.PpmPixelRGB8 r g b) = toDouble $ PixelRGB r g b
+  convert (PNM.PpmPixelRGB8 r g b) = fmap toDouble $ PixelRGB r g b
 
 instance Convertible PNM.PpmPixelRGB16 (Pixel RGB Double) where
-  convert (PNM.PpmPixelRGB16 r g b) = toDouble $ PixelRGB r g b
+  convert (PNM.PpmPixelRGB16 r g b) = fmap toDouble $ PixelRGB r g b
 
 
 -- -> RGBA (Double)
@@ -190,35 +191,35 @@
 
 -- BMP Format Reading (exact)
 
-instance Array arr Binary Bit => Readable (Image arr Binary Bit) PBM where
+instance Readable (Image VS Binary Bit) PBM where
   decode _ = either Left (ppmToImageUsing pnmDataPBMToImage . head) . decodePnm
 
-instance Array arr Y Word8 => Readable (Image arr Y Word8) PGM where
+instance Readable (Image VS Y Word8) PGM where
   decode _ = either Left (ppmToImageUsing pnmDataPGM8ToImage . head) . decodePnm
 
-instance Array arr Y Word16 => Readable (Image arr Y Word16) PGM where
+instance Readable (Image VS Y Word16) PGM where
   decode _ = either Left (ppmToImageUsing pnmDataPGM16ToImage . head) . decodePnm
 
-instance Array arr RGB Word8 => Readable (Image arr RGB Word8) PPM where
+instance Readable (Image VS RGB Word8) PPM where
   decode _ = either Left (ppmToImageUsing pnmDataPPM8ToImage . head) . decodePnm
 
-instance Array arr RGB Word16 => Readable (Image arr RGB Word16) PPM where
+instance Readable (Image VS RGB Word16) PPM where
   decode _ = either Left (ppmToImageUsing pnmDataPPM16ToImage . head) . decodePnm
 
 
-instance Array arr Binary Bit => Readable [Image arr Binary Bit] [PBM] where
+instance Readable [Image VS Binary Bit] [PBM] where
   decode _ = pnmToImagesUsing pnmDataPBMToImage
 
-instance Array arr Y Word8 => Readable [Image arr Y Word8] [PGM] where
+instance Readable [Image VS Y Word8] [PGM] where
   decode _ = pnmToImagesUsing pnmDataPGM8ToImage
 
-instance Array arr Y Word16 => Readable [Image arr Y Word16] [PGM] where
+instance Readable [Image VS Y Word16] [PGM] where
   decode _ = pnmToImagesUsing pnmDataPGM16ToImage
 
-instance Array arr RGB Word8 => Readable [Image arr RGB Word8] [PPM] where
+instance Readable [Image VS RGB Word8] [PPM] where
   decode _ = pnmToImagesUsing pnmDataPPM8ToImage
 
-instance Array arr RGB Word16 => Readable [Image arr RGB Word16] [PPM] where
+instance Readable [Image VS RGB Word16] [PPM] where
   decode _ = pnmToImagesUsing pnmDataPPM16ToImage
 
 
@@ -228,8 +229,8 @@
   fmap (map (either error id . ppmToImageUsing conv)) . decodePnm
 
 
-getPx :: (Storable a, Convertible a b) => VS.Vector a -> Int -> (Int, Int) -> b
-getPx v w (i, j) = convert (v VS.! (i * w + j))
+getPx :: (Storable a, Convertible a b) => V.Vector a -> Int -> (Int, Int) -> b
+getPx v w (i, j) = convert (v V.! (i * w + j))
 
 
 pnmDataToImage :: (Array arr cs e, Convertible PNM.PbmPixel px,
@@ -243,29 +244,30 @@
 pnmDataToImage conv w h (PNM.PpmPixelDataRGB16 v) = makeImage (h, w) (conv . getPx v w)
 
 
-pnmDataPBMToImage :: (Array arr cs e, Convertible PNM.PbmPixel (Pixel cs e)) =>
-                     Int -> Int -> PNM.PpmPixelData -> Either String (Image arr cs e)
-pnmDataPBMToImage w h (PNM.PbmPixelData v) = Right $ makeImage (h, w) (getPx v w)
+makeImageUnsafe
+  :: (Storable a, Array VS cs e)
+  => (Int, Int) -> V.Vector a -> Image VS cs e
+makeImageUnsafe sz = fromStorableVector sz . V.unsafeCast
+
+
+pnmDataPBMToImage :: Int -> Int -> PNM.PpmPixelData -> Either String (Image VS Binary Bit)
+pnmDataPBMToImage w h (PNM.PbmPixelData v) = Right $ makeImageUnsafe (h, w) v
 pnmDataPBMToImage _ _ d                    = pnmCSError "Binary (Pixel Binary Bit)" d
 
-pnmDataPGM8ToImage :: (Array arr cs e, Convertible PNM.PgmPixel8 (Pixel cs e)) =>
-                      Int -> Int -> PNM.PpmPixelData -> Either String (Image arr cs e)
-pnmDataPGM8ToImage w h (PNM.PgmPixelData8 v) = Right $ makeImage (h, w) (getPx v w)
+pnmDataPGM8ToImage :: Int -> Int -> PNM.PpmPixelData -> Either String (Image VS Y Word8)
+pnmDataPGM8ToImage w h (PNM.PgmPixelData8 v) = Right $ makeImageUnsafe (h, w) v
 pnmDataPGM8ToImage _ _ d                     = pnmCSError "Y8 (Pixel Y Word8)" d
 
-pnmDataPGM16ToImage :: (Array arr cs e, Convertible PNM.PgmPixel16 (Pixel cs e)) =>
-                       Int -> Int -> PNM.PpmPixelData -> Either String (Image arr cs e)
-pnmDataPGM16ToImage w h (PNM.PgmPixelData16 v) = Right $ makeImage (h, w) (getPx v w)
+pnmDataPGM16ToImage :: Int -> Int -> PNM.PpmPixelData -> Either String (Image VS Y Word16)
+pnmDataPGM16ToImage w h (PNM.PgmPixelData16 v) = Right $ makeImageUnsafe (h, w) v
 pnmDataPGM16ToImage _ _ d                      = pnmCSError "Y16 (Pixel Y Word16)" d
 
-pnmDataPPM8ToImage :: (Array arr cs e, Convertible PNM.PpmPixelRGB8 (Pixel cs e)) =>
-                      Int -> Int -> PNM.PpmPixelData -> Either String (Image arr cs e)
-pnmDataPPM8ToImage w h (PNM.PpmPixelDataRGB8 v) = Right $ makeImage (h, w) (getPx v w)
+pnmDataPPM8ToImage :: Int -> Int -> PNM.PpmPixelData -> Either String (Image VS RGB Word8)
+pnmDataPPM8ToImage w h (PNM.PpmPixelDataRGB8 v) = Right $ makeImageUnsafe (h, w) v
 pnmDataPPM8ToImage _ _ d                        = pnmCSError "RGB8 (Pixel RGB Word8)" d
 
-pnmDataPPM16ToImage :: (Array arr cs e, Convertible PNM.PpmPixelRGB16 (Pixel cs e)) =>
-                       Int -> Int -> PNM.PpmPixelData -> Either String (Image arr cs e)
-pnmDataPPM16ToImage w h (PNM.PpmPixelDataRGB16 v) = Right $ makeImage (h, w) (getPx v w)
+pnmDataPPM16ToImage :: Int -> Int -> PNM.PpmPixelData -> Either String (Image VS RGB Word16)
+pnmDataPPM16ToImage w h (PNM.PpmPixelDataRGB16 v) = Right $ makeImageUnsafe (h, w) v
 pnmDataPPM16ToImage _ _ d                         = pnmCSError "RGB16 (Pixel RGB Word16)" d
 
 
diff --git a/src/Graphics/Image/IO/Histogram.hs b/src/Graphics/Image/IO/Histogram.hs
--- a/src/Graphics/Image/IO/Histogram.hs
+++ b/src/Graphics/Image/IO/Histogram.hs
@@ -11,24 +11,26 @@
 -- Portability : non-portable
 --
 module Graphics.Image.IO.Histogram (
-  Histogram(..), Histograms, getHistograms, getHistogram,
+  Histogram(..), Histograms, ChannelColour(..), getHistograms, getHistogram,
   displayHistograms, writeHistograms
   ) where
 
 import Prelude as P 
 import Control.Concurrent (forkIO)
 import Control.Monad (void)
-import Graphics.Image.Interface as I
-import Graphics.Image.IO
-import Graphics.Image.ColorSpace
-import Graphics.Rendering.Chart.Easy
-import Graphics.Rendering.Chart.Backend.Diagrams
 import qualified Data.Colour as C
+import qualified Data.Colour.Names as C
 import qualified Data.Vector.Unboxed as V
 import System.Directory (getTemporaryDirectory)
 import System.FilePath ((</>))
 import System.IO.Temp (createTempDirectory)
 
+import Graphics.Image.Interface as I
+import Graphics.Image.IO
+import Graphics.Image.ColorSpace
+import Graphics.Rendering.Chart.Easy
+import Graphics.Rendering.Chart.Backend.Diagrams
+
 #if MIN_VERSION_vector(0,11,0)
 import Data.Vector.Unboxed.Mutable (modify)
 #else
@@ -42,6 +44,12 @@
 #endif
 
 
+class ChannelColour cs where
+ 
+  -- | Get a pure colour representation of a channel.
+  csColour :: cs -> C.AlphaColour Double
+
+
 -- | A single channel histogram of an image.
 data Histogram = Histogram { hBins :: V.Vector Int
                              -- ^ Vector containing pixel counts. Index of a
@@ -57,8 +65,8 @@
 type Histograms = [Histogram]
 
 -- | Create a histogram per channel with 256 bins each.
-getHistograms :: forall arr cs e . (MArray arr Gray e, Array arr Gray e, 
-                                    MArray arr cs e, Array arr cs e, Elevator e) =>
+getHistograms :: forall arr cs e . (ChannelColour cs, MArray arr Gray e, Array arr Gray e, 
+                                    MArray arr cs e, Array arr cs e) =>
                  Image arr cs e
               -> Histograms
 getHistograms = P.zipWith setCh (enumFrom (toEnum 0) :: [cs]) . P.map getHistogram . toGrayImages
@@ -66,7 +74,7 @@
                        , hColour = csColour cs }
 
 -- | Generate a histogram with 256 bins for a single channel Gray image.
-getHistogram :: (MArray arr Gray e, Elevator e) =>
+getHistogram :: MArray arr Gray e =>
                 Image arr Gray e
              -> Histogram
 getHistogram img = Histogram { hBins = V.modify countBins $
@@ -74,7 +82,7 @@
                                        (1 + fromIntegral (maxBound :: Word8)) (0 :: Int)
                              , hName = show Gray
                              , hColour = csColour Gray } where
-  incBin v (toWord8 -> PixelGray g) = modify v (+1) $ fromIntegral g
+  incBin v (PixelGray g) = modify v (+1) $ fromIntegral (toWord8 g)
   countBins v = I.mapM_ (incBin v) img
   
 
@@ -119,3 +127,64 @@
   if block
     then display
     else void $ forkIO display
+
+instance ChannelColour Gray where
+  csColour _ = C.opaque C.darkgray
+
+instance ChannelColour Y where
+  csColour _ = C.opaque C.darkgray
+
+instance ChannelColour YA where
+  csColour LumaYA  = csColour LumaY
+  csColour AlphaYA = C.opaque C.gray
+
+
+instance ChannelColour RGB where
+  csColour RedRGB   = C.opaque C.red
+  csColour GreenRGB = C.opaque C.green
+  csColour BlueRGB  = C.opaque C.blue
+
+instance ChannelColour RGBA where
+  csColour RedRGBA   = C.opaque C.red
+  csColour GreenRGBA = C.opaque C.green
+  csColour BlueRGBA  = C.opaque C.blue
+  csColour AlphaRGBA = C.opaque C.gray
+
+
+instance ChannelColour HSI where
+  csColour HueHSI = C.opaque C.purple
+  csColour SatHSI = C.opaque C.orange
+  csColour IntHSI = C.opaque C.darkblue
+
+instance ChannelColour HSIA where
+  csColour HueHSIA = C.opaque C.purple
+  csColour SatHSIA = C.opaque C.orange
+  csColour IntHSIA = C.opaque C.darkblue
+  csColour AlphaHSIA = C.opaque C.gray
+
+
+instance ChannelColour CMYK where
+  csColour CyanCMYK = C.opaque C.cyan
+  csColour MagCMYK  = C.opaque C.magenta
+  csColour YelCMYK  = C.opaque C.yellow
+  csColour KeyCMYK  = C.opaque C.black
+
+instance ChannelColour CMYKA where
+  csColour CyanCMYKA  = csColour CyanCMYK
+  csColour MagCMYKA   = csColour MagCMYK
+  csColour YelCMYKA   = csColour YelCMYK
+  csColour KeyCMYKA   = csColour KeyCMYK
+  csColour AlphaCMYKA = C.opaque C.grey
+
+
+instance ChannelColour YCbCr where
+  csColour LumaYCbCr  = C.opaque C.darkgray
+  csColour CBlueYCbCr = C.opaque C.darkblue
+  csColour CRedYCbCr  = C.opaque C.darkred
+
+
+instance ChannelColour YCbCrA where
+  csColour LumaYCbCrA  = csColour LumaYCbCr
+  csColour CBlueYCbCrA = csColour CBlueYCbCr
+  csColour CRedYCbCrA  = csColour CRedYCbCr
+  csColour AlphaYCbCrA = C.opaque C.gray
diff --git a/src/Graphics/Image/Interface.hs b/src/Graphics/Image/Interface.hs
--- a/src/Graphics/Image/Interface.hs
+++ b/src/Graphics/Image/Interface.hs
@@ -8,86 +8,103 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 #if __GLASGOW_HASKELL__ >= 800
-  {-# OPTIONS_GHC -Wno-redundant-constraints #-}
-  {-# LANGUAGE UndecidableSuperClasses #-}
+    {-# OPTIONS_GHC -Wno-redundant-constraints #-}
+    {-# LANGUAGE UndecidableSuperClasses #-}
 #endif
 {-# LANGUAGE ViewPatterns #-}
 -- |
 -- Module      : Graphics.Image.Interface
--- Copyright   : (c) Alexey Kuleshevich 2016
+-- Copyright   : (c) Alexey Kuleshevich 2017
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
 -- Portability : non-portable
 --
 module Graphics.Image.Interface (
-  ColorSpace(..), Alpha(..), Elevator(..),
+  Pixel, ColorSpace(..), AlphaSpace(..), Elevator(..),
   BaseArray(..), Array(..), MArray(..),
   Exchangable(..), exchangeFrom,
   defaultIndex, borderIndex, maybeIndex, Border(..), handleBorderIndex,
+  fromIx, toIx, checkDims
+#if !MIN_VERSION_base(4,8,0)
+  , module Control.Applicative
+  , Foldable
+#endif
   ) where
 
 import Prelude hiding (and, map, zipWith, sum, product)
 #if !MIN_VERSION_base(4,8,0)
-import Data.Monoid (Monoid)
-import Data.Foldable (Foldable(foldMap))
+import Control.Applicative
 #endif
+import Data.Maybe (fromMaybe)
+import Data.Foldable
 import GHC.Exts (Constraint)
 import Data.Typeable (Typeable, showsTypeRep, typeOf)
-import Control.DeepSeq (NFData(rnf))
+import Control.DeepSeq (NFData(rnf), deepseq)
 import Data.Word
-import Control.Applicative
+
 import Control.Monad.Primitive (PrimMonad (..))
-import qualified Data.Colour as C
 
 
--- | This class has all included color spaces installed into it and is also
--- intended for implementing any other possible custom color spaces. Every
--- instance of this class automatically installs an associated 'Pixel' into
--- 'Num', 'Fractional', 'Floating', 'Functor', 'Applicative' and 'Foldable',
--- which in turn make it possible to be used by the rest of the library.
-class (Eq cs, Enum cs, Show cs, Typeable cs) => ColorSpace cs where
-  
-  -- | Representation of a pixel, such that it can be an element of any
-  -- Array. Which is usally a tuple of channels or a channel itself for single
-  -- channel color spaces.
-  type PixelElt cs e
+-- | A Pixel family with a color space and a precision of elements.
+data family Pixel cs e :: *
 
-  -- | A concrete Pixel representation for a particular color space.
-  data Pixel cs e
 
-  -- | Construt a pixel by replicating a same value among all of the channels.
-  fromChannel :: e -> Pixel cs e
+class (Eq cs, Enum cs, Show cs, Typeable cs, Elevator e, Typeable e) => ColorSpace cs e where
+  
+  type Components cs e
 
   -- | Convert a Pixel to a representation suitable for storage as an unboxed
   -- element, usually a tuple of channels.
-  toElt :: Pixel cs e -> PixelElt cs e
+  toComponents :: Pixel cs e -> Components cs e
 
   -- | Convert from an elemnt representation back to a Pixel.
-  fromElt :: PixelElt cs e -> Pixel cs e
+  fromComponents :: Components cs e -> Pixel cs e
 
-  -- | Retrieve Pixel's channel value
-  getPxCh :: Pixel cs e -> cs -> e
+  -- | Construt a pixel by replicating a same value among all of the components.
+  broadcastC :: e -> Pixel cs e
+
+  -- | Retrieve Pixel's component value
+  getPxC :: Pixel cs e -> cs -> e
   
-  -- | Map a channel aware function over all Pixel's channels.
-  chOp :: (cs -> e' -> e) -> Pixel cs e' -> Pixel cs e 
+  -- | Set Pixel's component value
+  setPxC :: Pixel cs e -> cs -> e -> Pixel cs e
+  
+  -- | Map a channel aware function over all Pixel's components.
+  mapPxC :: (cs -> e -> e) -> Pixel cs e -> Pixel cs e 
 
-  -- | Map a function over all Pixel's channels.
-  pxOp :: (e' -> e) -> Pixel cs e' -> Pixel cs e
+  -- | Map a function over all Pixel's componenets.
+  mapPx :: (e -> e) -> Pixel cs e -> Pixel cs e
 
-  -- | Function application to a Pixel.
-  chApp :: Pixel cs (e' -> e) -> Pixel cs e' -> Pixel cs e
+  -- | Zip two Pixels with a function.
+  zipWithPx :: (e -> e -> e) -> Pixel cs e -> Pixel cs e -> Pixel cs e
 
-  -- | A pixel eqiuvalent of 'foldMap'.
-  pxFoldMap :: Monoid m => (e -> m) -> Pixel cs e -> m
+  -- | Right fold over all Pixel's components.
+  foldrPx :: (e -> b -> b) -> b -> Pixel cs e -> b
+  foldrPx f !z0 !xs = foldlPx f' id xs z0
+      where f' k x !z = k $! f x z
 
-  -- | Get a pure colour representation of a channel.
-  csColour :: cs -> C.AlphaColour Double
+  -- | Left strict fold over all Pixel's components.
+  foldlPx :: (b -> e -> b) -> b -> Pixel cs e -> b
+  foldlPx f !z0 !xs = foldrPx f' id xs z0
+      where f' x k !z = k $! f z x
+
+  foldl1Px :: (e -> e -> e) -> Pixel cs e -> e
+  foldl1Px f !xs = fromMaybe (error "foldl1: empty Pixel")
+                  (foldlPx mf Nothing xs)
+      where
+        mf m !y = Just (case m of
+                           Nothing -> y
+                           Just x  -> f x y)
+  toListPx :: Pixel cs e -> [e]
+  toListPx !px = foldr' f [] (enumFrom (toEnum 0))
+    where f !cs !ls = getPxC px cs:ls
+
   
 
 -- | A color space that supports transparency.
-class (ColorSpace (Opaque cs), ColorSpace cs) => Alpha cs where
-  -- | An corresponding opaque version of this color space.
+class (ColorSpace (Opaque cs) e, ColorSpace cs e) => AlphaSpace cs e where
+  -- | A corresponding opaque version of this color space.
   type Opaque cs
 
   -- | Get an alpha channel of a transparant pixel. 
@@ -105,10 +122,7 @@
   --
   dropAlpha :: Pixel cs e -> Pixel (Opaque cs) e
 
-  -- | Get a corresponding opaque channel type.
-  opaque :: cs -> Opaque cs
 
-
 -- | A class with a set of convenient functions that allow for changing precision of
 -- channels within pixels, while scaling the values to keep them in an appropriate range.
 --
@@ -118,30 +132,36 @@
 --
 class Elevator e where
 
-  toWord8 :: ColorSpace cs => Pixel cs e -> Pixel cs Word8
+  -- | Values are scaled to @[0, 255]@ range.
+  toWord8 :: e -> Word8
 
-  toWord16 :: ColorSpace cs => Pixel cs e -> Pixel cs Word16
+  -- | Values are scaled to @[0, 65535]@ range.
+  toWord16 :: e -> Word16
 
-  toWord32 :: ColorSpace cs => Pixel cs e -> Pixel cs Word32
+  -- | Values are scaled to @[0, 4294967295]@ range.
+  toWord32 :: e -> Word32
 
-  toWord64 :: ColorSpace cs => Pixel cs e -> Pixel cs Word64
+  -- | Values are scaled to @[0, 18446744073709551615]@ range.
+  toWord64 :: e -> Word64
 
-  toFloat :: ColorSpace cs => Pixel cs e -> Pixel cs Float
+  -- | Values are scaled to @[0.0, 1.0]@ range.
+  toFloat :: e -> Float
 
-  toDouble :: ColorSpace cs => Pixel cs e -> Pixel cs Double
+  -- | Values are scaled to @[0.0, 1.0]@ range.
+  toDouble :: e -> Double
 
-  fromDouble :: ColorSpace cs => Pixel cs Double -> Pixel cs e
+  -- | Values are scaled from @[0.0, 1.0]@ range.
+  fromDouble :: Double -> e
 
 
 -- | Base array like representation for an image.
-class (Show arr, ColorSpace cs, Num (Pixel cs e),
-       Functor (Pixel cs), Applicative (Pixel cs), Foldable (Pixel cs),
-       Num e, Typeable e, Elt arr cs e) =>
+class (Show arr, ColorSpace cs e, Num (Pixel cs e),
+       SuperClass arr cs e) =>
       BaseArray arr cs e where
 
   -- | Required array specific constraints for an array element.
-  type Elt arr cs e :: Constraint
-  type Elt arr cs e = ()
+  type SuperClass arr cs e :: Constraint
+  type SuperClass arr cs e = ()
 
   -- | Underlying image representation.
   data Image arr cs e
@@ -169,6 +189,14 @@
                -- argument and returns a pixel for that location.
             -> Image arr cs e
 
+  makeImageWindowed :: (Int, Int) -- ^ (@m@ rows, @n@ columns) - dimensions of a new image.
+                    -> ((Int, Int), (Int, Int))
+                    -> ((Int, Int) -> Pixel cs e)
+                       -- ^ Function that generates inner pixels.
+                    -> ((Int, Int) -> Pixel cs e)
+                       -- ^ Function that generates border pixels
+                    -> Image arr cs e
+
   -- | Create a singleton image, required for various operations on images with
   -- a scalar.
   singleton :: Pixel cs e -> Image arr cs e
@@ -242,18 +270,32 @@
   -- | Construct an image from a nested rectangular shaped list of pixels.
   -- Length of an outer list will constitute @m@ rows, while the length of inner lists -
   -- @n@ columns. All of the inner lists must be the same length and greater than @0@.
+  --
+  -- >>> fromLists [[PixelY (fromIntegral (i*j) / 60000) | j <- [1..300]] | i <- [1..200]]
+  -- <Image VectorUnboxed Y (Double): 200x300>
+  --
+  -- <<images/grad_fromLists.png>>
+  --
   fromLists :: [[Pixel cs e]]
             -> Image arr cs e
 
   -- | Perform matrix multiplication on two images. Inner dimensions must agree.
   (|*|) :: Image arr cs e -> Image arr cs e -> Image arr cs e
 
-  -- | Undirected reduction of an image.
+  -- | Undirected reduction of an image. 
   fold :: (Pixel cs e -> Pixel cs e -> Pixel cs e) -- ^ An associative folding function.
        -> Pixel cs e -- ^ Initial element, that is neutral with respect to the folding function.
        -> Image arr cs e -- ^ Source image.
        -> Pixel cs e
 
+  -- | Undirected reduction of an image with an index aware function.
+  foldIx :: (Pixel cs e -> (Int, Int) -> Pixel cs e -> Pixel cs e)
+            -- ^ Function that takes an accumulator, index, a pixel at that
+            -- index and returns a new accumulator pixel.
+         -> Pixel cs e -- ^ Initial element, that is neutral with respect to the folding function.
+         -> Image arr cs e -- ^ Source image.
+         -> Pixel cs e
+
   -- | Pixelwise equality function of two images. Images are
   -- considered distinct if either images' dimensions or at least one pair of
   -- corresponding pixels are not the same. Used in defining an in instance for
@@ -268,7 +310,7 @@
 -- | Array representation that is actually has real data stored in memory, hence
 -- allowing for image indexing, forcing pixels into computed state etc.
 class BaseArray arr cs e => MArray arr cs e  where
-  data MImage st arr cs e
+  data MImage s arr cs e
 
   unsafeIndex :: Image arr cs e -> (Int, Int) -> Pixel cs e
   
@@ -314,7 +356,7 @@
   foldM_ :: (Functor m, Monad m) => (a -> Pixel cs e -> m a) -> a -> Image arr cs e -> m ()
 
   -- | Get dimensions of a mutable image.
-  mdims :: MImage st arr cs e -> (Int, Int)
+  mdims :: MImage s arr cs e -> (Int, Int)
 
   -- | Yield a mutable copy of an image.
   thaw :: (Functor m, PrimMonad m) =>
@@ -461,105 +503,45 @@
 {-# INLINE maybeIndex #-}
 
 
+-- | 2D to a flat vector index conversion.
+--
+-- __Note__: There is an implicit assumption that @j < n@
+fromIx :: Int -- ^ @n@ columns
+       -> (Int, Int) -- ^ @(i, j)@ row, column index
+       -> Int -- ^ Flat vector index
+fromIx !n !(i, j) = n * i + j
+{-# INLINE fromIx #-}
 
-instance ColorSpace cs => Functor (Pixel cs) where
 
-  fmap = pxOp
-  {-# INLINE fmap #-}
-  
-instance ColorSpace cs => Applicative (Pixel cs) where
-
-  pure = fromChannel
-  {-# INLINE pure #-}
-
-  (<*>) = chApp
-  {-# INLINE (<*>) #-}
+-- | Flat vector to 2D index conversion.
+toIx :: Int -- ^ @n@ columns
+     -> Int -- ^ Flat vector index
+     -> (Int, Int) -- ^ @(i, j)@ row, column index
+toIx !n !k = divMod k n
+{-# INLINE toIx #-}
 
 
-instance ColorSpace cs => Foldable (Pixel cs) where
-
-  foldMap = pxFoldMap
-  {-# INLINE foldMap #-}
+checkDims :: String -> (Int, Int) -> (Int, Int)
+checkDims err !ds@(m, n)
+  | m <= 0 || n <= 0 = 
+    error $
+    show err ++ ": Image dimensions are expected to be non-negative: " ++ show ds
+  | otherwise = ds
+{-# INLINE checkDims #-}
 
 
-instance (ColorSpace cs, Num e) => Num (Pixel cs e) where
-  (+)         = liftA2 (+)
-  {-# INLINE (+) #-}
-  
-  (-)         = liftA2 (-)
-  {-# INLINE (-) #-}
-  
-  (*)         = liftA2 (*)
-  {-# INLINE (*) #-}
-  
-  abs         = liftA abs
-  {-# INLINE abs #-}
-  
-  signum      = liftA signum
-  {-# INLINE signum #-}
-  
-  fromInteger = pure . fromInteger
-  {-# INLINE fromInteger #-}
-  
-
-instance (ColorSpace cs, Fractional e) => Fractional (Pixel cs e) where
-  (/)          = liftA2 (/)
-  {-# INLINE (/) #-}
+instance (Applicative (Pixel cs), Bounded e) => Bounded (Pixel cs e) where
+  maxBound = pure maxBound
+  {-# INLINE maxBound #-}
   
-  recip        = liftA recip
-  {-# INLINE recip #-}
-
-  fromRational = pure . fromRational
-  {-# INLINE fromRational #-}
+  minBound = pure minBound
+  {-# INLINE minBound #-}
 
 
-instance (ColorSpace cs, Floating e) => Floating (Pixel cs e) where
-  pi      = fromChannel pi
-  {-# INLINE pi #-}
-
-  exp     = liftA exp
-  {-# INLINE exp #-}
-
-  log     = liftA log
-  {-# INLINE log #-}
-  
-  sin     = liftA sin
-  {-# INLINE sin #-}
-  
-  cos     = liftA cos
-  {-# INLINE cos #-}
-  
-  asin    = liftA asin
-  {-# INLINE asin #-}
-  
-  atan    = liftA atan
-  {-# INLINE atan #-}
-  
-  acos    = liftA acos
-  {-# INLINE acos #-}
-  
-  sinh    = liftA sinh
-  {-# INLINE sinh #-}
-  
-  cosh    = liftA cosh
-  {-# INLINE cosh #-}
-  
-  asinh   = liftA asinh
-  {-# INLINE asinh #-}
-  
-  atanh   = liftA atanh
-  {-# INLINE atanh #-}
-  
-  acosh   = liftA acosh
-  {-# INLINE acosh #-}
-
+instance (Foldable (Pixel cs), NFData e) => NFData (Pixel cs e) where
 
-instance (ColorSpace cs, Bounded e) => Bounded (Pixel cs e) where
-  maxBound = fromChannel maxBound
-  {-# INLINE maxBound #-}
-  
-  minBound = fromChannel minBound
-  {-# INLINE minBound #-}
+  rnf = foldr' deepseq ()
+  {-# INLINE rnf #-}
 
 
 instance (Array arr cs e, Eq (Pixel cs e)) => Eq (Image arr cs e) where
diff --git a/src/Graphics/Image/Interface/Repa.hs b/src/Graphics/Image/Interface/Repa.hs
--- a/src/Graphics/Image/Interface/Repa.hs
+++ b/src/Graphics/Image/Interface/Repa.hs
@@ -1,4 +1,6 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 -- |
 -- Module      : Graphics.Image.Interface.Repa
 -- Copyright   : (c) Alexey Kuleshevich 2016
@@ -8,50 +10,69 @@
 -- Portability : non-portable
 --
 module Graphics.Image.Interface.Repa (
-  -- * Construction
-  makeImageS, makeImageP, fromListsS, fromListsP,
-  -- * Representation
-  RS(..), RP(..),
   -- * Conversion
-  fromRepaArrayS, fromRepaArrayP, toRepaArray
+  --fromRepaArrayS, fromRepaArrayP,
+  toRepaArray,
+  -- * Representation
+  RSU(..), RPU(..), RSS(..), RPS(..)
   ) where
 
-import Graphics.Image.Interface hiding (makeImage, fromLists)
-import qualified Graphics.Image.Interface as I (makeImage, fromLists)
-import Graphics.Image.Interface.Repa.Internal
+import Data.Array.Repa.Index
+import qualified Data.Array.Repa as R
 
+import Graphics.Image.Interface
+import Graphics.Image.Interface.Repa.Generic
+import Graphics.Image.Interface.Repa.Storable
+import Graphics.Image.Interface.Repa.Unboxed
 
--- | Create an image with sequential array representation.
-makeImageS :: Array RS cs Double =>
-             (Int, Int) -- ^ (@m@ rows, @n@ columns) - dimensions of a new image.
-          -> ((Int, Int) -> Pixel cs Double)
-             -- ^ A function that takes (@i@-th row, and @j@-th column) as an argument
-             -- and returns a pixel for that location.
-          -> Image RS cs Double
-makeImageS = I.makeImage
-{-# INLINE makeImageS #-}
 
--- | Create an image with parallel array representation.
-makeImageP :: Array RP cs Double =>
-             (Int, Int) -- ^ (@m@ rows, @n@ columns) - dimensions of a new image.
-          -> ((Int, Int) -> Pixel cs Double)
-             -- ^ A function that takes (@i@-th row, and @j@-th column) as an argument
-             -- and returns a pixel for that location.
-          -> Image RP cs Double
-makeImageP = I.makeImage
-{-# INLINE makeImageP #-}
 
 
--- | Construct an image from a nested rectangular shaped list of pixels sequentially.
-fromListsS
-  :: Array RS cs e
-  => [[Pixel cs e]] -> Image RS cs e
-fromListsS = I.fromLists
-{-# INLINE fromListsS #-}
 
--- | Construct an image from a nested rectangular shaped list of pixels in parallel.
-fromListsP
-  :: Array RP cs e
-  => [[Pixel cs e]] -> Image RP cs e
-fromListsP = I.fromLists
-{-# INLINE fromListsP #-}
+-- | Makes a copy of an image into a Storable representation sequentially.
+instance Exchangable RSU RSS where
+  exchange _ (SUImage (SScalar px)) = SSImage (SScalar px)
+  exchange _ (SUImage img)          = SSImage . compute . SDImage . getDelayedS $ img
+  {-# INLINE exchange #-}
+
+
+-- | Makes a copy of an image into a Storable representation sequentially.
+instance Exchangable RPU RPS where
+  exchange _ (PUImage (PScalar px)) = PSImage (PScalar px)
+  exchange _ (PUImage img)          = PSImage . compute . PDImage . getDelayedP $ img
+  {-# INLINE exchange #-}
+
+
+-- | Makes a copy of an image into a Unboxed representation sequentially.
+instance Exchangable RSS RSU where
+  exchange _ (SSImage (SScalar px)) = SUImage (SScalar px)
+  exchange _ (SSImage img)          = SUImage . compute . SDImage . getDelayedS $ img
+  {-# INLINE exchange #-}
+
+
+-- | Makes a copy of an image into a Unboxed representation sequentially.
+instance Exchangable RPS RPU where
+  exchange _ (PSImage (PScalar px)) = PUImage (PScalar px)
+  exchange _ (PSImage img)          = PUImage . compute . PDImage . getDelayedP $ img
+  {-# INLINE exchange #-}
+
+
+
+-- -- | Create a sequential image from a 2D Repa delayed array.
+-- fromRepaArrayS :: R.Array R.D DIM2 (Pixel cs e) -> Image RS cs e
+-- fromRepaArrayS = SDImage
+
+
+-- -- | Create a parallel image from a 2D Repa delayed array.
+-- fromRepaArrayP :: R.Array R.D DIM2 (Pixel cs e) -> Image RP cs e
+-- fromRepaArrayP = PDImage
+
+-- | Retrieve an underlying Repa array from an image.
+toRepaArray
+  :: (Array arr cs e, Array RSU cs e, Exchangable arr RSU)
+  => Image arr cs e -> R.Array R.U DIM2 (Pixel cs e)
+toRepaArray img =
+  case exchange RSU img of
+    (SUImage (STImage arr)) -> arr
+    (SUImage (SDImage arr)) -> R.computeS arr
+    (SUImage (SScalar px))  -> R.computeS $ R.fromFunction (Z :. 1 :. 1) $ const px
diff --git a/src/Graphics/Image/Interface/Repa/Generic.hs b/src/Graphics/Image/Interface/Repa/Generic.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/Image/Interface/Repa/Generic.hs
@@ -0,0 +1,494 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+#if __GLASGOW_HASKELL__ >= 800
+    {-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
+#endif
+-- |
+-- Module      : Graphics.Image.Interface.Repa.Generic
+-- Copyright   : (c) Alexey Kuleshevich 2017
+-- License     : BSD3
+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
+-- Stability   : experimental
+-- Portability : non-portable
+--
+module Graphics.Image.Interface.Repa.Generic where
+
+import Prelude as P
+import Data.Array.Repa.Index
+import qualified Data.Array.Repa as R
+import qualified Data.Array.Repa.Eval as R
+
+import Graphics.Image.ColorSpace.Binary (Bit(..))
+import Graphics.Image.Interface as I
+import qualified Graphics.Image.Interface.Vector.Unboxed as IVU
+import qualified Graphics.Image.Interface.Vector.Generic as IVG
+import Graphics.Image.Interface.Repa.Helpers
+
+
+type family Repr arr :: *
+
+
+-- | Repa Array representation, which is computed in parallel.
+data RP r = RP r
+
+-- | Repa Array representation, which is computed sequentially. 
+data RS r = RS r
+
+instance Show r => Show (RP r) where
+  show (RP r) = "RepaParallel " ++ show r
+  
+instance Show r => Show (RS r) where
+  show (RS r) = "RepaSequential " ++ show r
+
+
+-----------------------
+-- Sequential Arrays --
+-----------------------
+
+instance SuperClass (RS r) cs e => BaseArray (RS r) cs e where
+  type SuperClass (RS r) cs e =
+    (Show r, ColorSpace cs e, Num (Pixel cs e), R.Elt (Pixel cs e), R.Elt e, 
+     R.Target (Repr (RS r)) (Pixel cs e), R.Source (Repr (RS r)) (Pixel cs e),
+     IVU.Unbox e, IVU.Unbox (Components cs e), 
+     BaseArray (IVG.V r) cs e, Repr (RP r) ~ Repr (RS r))
+  
+  data Image (RS r) cs e = SScalar !(Pixel cs e)
+                         | STImage !(R.Array (Repr (RS r)) R.DIM2 (Pixel cs e))
+                         | SDImage !(R.Array R.D R.DIM2 (Pixel cs e))
+                       
+  dims (SScalar _                          ) = (1, 1)
+  dims (STImage (R.extent -> (Z :. m :. n))) = (m, n)
+  dims (SDImage (R.extent -> (Z :. m :. n))) = (m, n)
+  {-# INLINE dims #-}
+
+
+instance (BaseArray (RS r) cs e) => Array (RS r) cs e where
+
+  type Manifest (RS r) = Manifest (IVG.V r)
+  
+  makeImage !(checkDims "RS.makeImage" -> (m, n)) f =
+    SDImage $ R.fromFunction (Z :. m :. n) (f . sh2ix)
+  {-# INLINE makeImage #-}
+  
+  makeImageWindowed !(checkDims "RS.makeImage" -> (m, n)) !window getWindowPx getBorderPx  =
+    SDImage $ R.delay $ makeWindowed (Z :. m :. n) window
+    (R.fromFunction (Z :. m :. n) (getWindowPx . sh2ix))
+     (R.fromFunction (Z :. m :. n) (getBorderPx . sh2ix))
+    
+  singleton = SScalar
+  {-# INLINE singleton #-}
+
+  index00 (SScalar px)  = px
+  index00 (STImage arr) = R.index arr (Z :. 0 :. 0)
+  index00 (SDImage arr) = R.index arr (Z :. 0 :. 0)
+  {-# INLINE index00 #-}
+
+  map f (SScalar px)  = SScalar (f px)
+  map f (STImage arr) = SDImage (R.map f arr)
+  map f (SDImage arr) = SDImage (R.map f arr)
+  {-# INLINE map #-}
+
+  imap f (SScalar px)  = SScalar (f (0, 0) px)
+  imap f (STImage arr) = SDImage (imapR f arr)
+  imap f (SDImage arr) = SDImage (imapR f arr)
+  {-# INLINE imap #-}
+
+  zipWith f (SScalar px1) (SScalar px2) = SScalar (f px1 px2)
+  zipWith f (SScalar px1) !img2         = I.map (f px1) img2
+  zipWith f !img1         (SScalar px2) = I.map (`f` px2) img1
+  zipWith f !img1         !img2         =
+    SDImage (R.zipWith f (getDelayedS img1) (getDelayedS img2))
+  {-# INLINE zipWith #-}
+
+  izipWith f (SScalar px1) (SScalar px2) = SScalar (f (0, 0) px1 px2)
+  izipWith f (SScalar px1) !img2         = imap (`f` px1) img2
+  izipWith f !img1         (SScalar px2) = imap (\ !ix !px -> f ix px px2) img1
+  izipWith f !img1         !img2         =
+    SDImage (izipWithR f (getDelayedS img1) (getDelayedS img2))
+  {-# INLINE izipWith #-}
+  
+  traverse !img getNewDims getNewPx =
+    SDImage (traverseR (getDelayedS img) getNewDims getNewPx)
+  {-# INLINE traverse #-}
+
+  traverse2 !img1 !img2 getNewDims getNewPx =
+    SDImage (traverse2R (getDelayedS img1) (getDelayedS img2) getNewDims getNewPx)
+  {-# INLINE traverse2 #-}
+
+  transpose (SDImage arr) = SDImage (R.transpose arr)
+  transpose (STImage arr) = SDImage (R.transpose arr)
+  transpose !img          = img
+  {-# INLINE transpose #-}
+
+  backpermute !newDims g !img = SDImage (backpermuteR (getDelayedS img) newDims g)
+  {-# INLINE backpermute #-}
+
+  fromLists = STImage . fromListsR
+  {-# INLINE fromLists #-}
+
+  fold f !px0 (SDImage arr) = R.foldAllS f px0 arr
+  fold f !px0 (STImage arr) = R.foldAllS f px0 arr
+  fold f !px0 (SScalar px)  = f px px0
+  {-# INLINE fold #-}
+
+  foldIx f !px0 (SDImage arr) = foldIxS f px0 arr
+  foldIx f !px0 (STImage arr) = foldIxS f px0 arr
+  foldIx f !px0 (SScalar px)  = f px0 (0, 0) px
+  {-# INLINE foldIx #-}
+
+  eq (SScalar px1) (SScalar px2) = px1 == px2
+  eq !img1 !img2 = R.equalsS (getDelayedS img1) (getDelayedS img2)
+  {-# INLINE eq #-}
+
+  compute !img@(SScalar _) = img
+  compute !img@(STImage _) = img
+  compute (SDImage arr)    = STImage (R.computeS arr)
+  {-# INLINE compute #-}
+
+  (|*|) img1@(STImage arr1) img2@(STImage arr2) =
+     SDImage (multR (show img1 ++ " X " ++ show img2) arr1 arr2)
+  (|*|) img1@(SDImage _) !img2            = compute img1 |*| img2
+  (|*|) !img1            img2@(SDImage _) = img1 |*| compute img2
+  (|*|) (SScalar px1)    !img2            = STImage (singletonR px1) |*| img2
+  (|*|) !img1            (SScalar px2)    = img1 |*| STImage (singletonR px2)
+  {-# INLINE (|*|) #-}
+
+  toManifest _ = error $ "RS.toManifest: Cannot convert generic Repa " ++
+                         "representation to a generic Vector."
+  {-# INLINE toManifest #-}
+
+
+---------------------
+-- Parallel Arrays --
+---------------------
+
+
+
+instance SuperClass (RP r) cs e => BaseArray (RP r) cs e where
+  type SuperClass (RP r) cs e = (
+    Show r, ColorSpace cs e, Num (Pixel cs e),
+    R.Target (Repr (RP r)) (Pixel cs e), R.Source (Repr (RP r)) (Pixel cs e),
+    BaseArray (IVG.V r) cs e, Repr (RP r) ~ Repr (RS r),
+    IVU.Unbox e, IVU.Unbox (Components cs e), R.Elt e, R.Elt (Pixel cs e))
+  
+  data Image (RP r) cs e = PScalar !(Pixel cs e)
+                         | PTImage !(R.Array (Repr (RP r)) R.DIM2 (Pixel cs e))
+                         | PDImage !(R.Array R.D R.DIM2 (Pixel cs e))
+                       
+  dims (PScalar _                          ) = (1, 1)
+  dims (PTImage (R.extent -> (Z :. m :. n))) = (m, n)
+  dims (PDImage (R.extent -> (Z :. m :. n))) = (m, n)
+  {-# INLINE dims #-}
+
+
+instance (BaseArray (RP r) cs e) => Array (RP r) cs e where
+
+  type Manifest (RP r) = Manifest (IVG.V r)
+  
+  makeImage !(checkDims "RP.makeImage" -> (m, n)) f =
+    PDImage $ R.fromFunction (Z :. m :. n) (f . sh2ix)
+  {-# INLINE makeImage #-}
+  
+  makeImageWindowed !(checkDims "RP.makeImage" -> (m, n)) !window getWindowPx getBorderPx  =
+    PDImage $ R.delay $ makeWindowed (Z :. m :. n) window
+    (R.fromFunction (Z :. m :. n) (getWindowPx . sh2ix))
+     (R.fromFunction (Z :. m :. n) (getBorderPx . sh2ix))
+    
+  singleton = PScalar
+  {-# INLINE singleton #-}
+
+  index00 (PScalar px)  = px
+  index00 (PTImage arr) = R.index arr (Z :. 0 :. 0)
+  index00 (PDImage arr) = R.index arr (Z :. 0 :. 0)
+  {-# INLINE index00 #-}
+
+  map f (PScalar px)  = PScalar (f px)
+  map f (PTImage arr) = PDImage (R.map f arr)
+  map f (PDImage arr) = PDImage (R.map f arr)
+  {-# INLINE map #-}
+
+  imap f (PScalar px)  = PScalar (f (0, 0) px)
+  imap f (PTImage arr) = PDImage (imapR f arr)
+  imap f (PDImage arr) = PDImage (imapR f arr)
+  {-# INLINE imap #-}
+
+  zipWith f (PScalar px1) (PScalar px2) = PScalar (f px1 px2)
+  zipWith f (PScalar px1) !img2         = I.map (f px1) img2
+  zipWith f !img1         (PScalar px2) = I.map (`f` px2) img1
+  zipWith f !img1         !img2         =
+    PDImage (R.zipWith f (getDelayedP img1) (getDelayedP img2))
+  {-# INLINE zipWith #-}
+
+  izipWith f (PScalar px1) (PScalar px2) = PScalar (f (0, 0) px1 px2)
+  izipWith f (PScalar px1) !img2         = imap (`f` px1) img2
+  izipWith f !img1         (PScalar px2) = imap (\ !ix !px -> f ix px px2) img1
+  izipWith f !img1         !img2         =
+    PDImage (izipWithR f (getDelayedP img1) (getDelayedP img2))
+  {-# INLINE izipWith #-}
+  
+  traverse !img getNewDims getNewPx =
+    PDImage (traverseR (getDelayedP img) getNewDims getNewPx)
+  {-# INLINE traverse #-}
+
+  traverse2 !img1 !img2 getNewDims getNewPx =
+    PDImage (traverse2R (getDelayedP img1) (getDelayedP img2) getNewDims getNewPx)
+  {-# INLINE traverse2 #-}
+
+  transpose (PDImage arr) = PDImage (R.transpose arr)
+  transpose (PTImage arr) = PDImage (R.transpose arr)
+  transpose !img          = img
+  {-# INLINE transpose #-}
+
+  backpermute !newDims g !img = PDImage (backpermuteR (getDelayedP img) newDims g)
+  {-# INLINE backpermute #-}
+
+  fromLists = PTImage . fromListsR
+  {-# INLINE fromLists #-}
+
+  fold f !px0 (PScalar px) = f px0 px
+  fold f !px0 img =
+    case R.foldAllP f px0 (getDelayedP img) of
+      Just e  -> e
+      Nothing -> error $ "RP.fold: impossible happened."
+  {-# INLINE fold #-}
+
+  foldIx f !px0 (PScalar px) = f px0 (0, 0) px
+  foldIx f !px0 img =
+    case foldIxPUnboxed f px0 (getDelayedP img) of
+      Just e  -> e
+      Nothing -> error $ "RP.foldIx: impossible happened."
+  {-# INLINE foldIx #-}
+
+
+  eq (PScalar px1) (PScalar px2) = px1 == px2
+  eq !img1 !img2 =
+    case R.equalsP (getDelayedP img1) (getDelayedP img2) of
+      Just e  -> e
+      Nothing -> error $ "RP.eq: impossible happened."
+  {-# INLINE eq #-}
+
+  compute !img@(PScalar _) = img
+  compute !img@(PTImage _) = img
+  compute (PDImage arr)    = arrManifest `R.deepSeqArray` PTImage arrManifest
+     where arrManifest = R.suspendedComputeP arr
+  {-# INLINE compute #-}
+
+  (|*|) img1@(PTImage arr1) img2@(PTImage arr2) =
+     PDImage (multR (show img1 ++ " X " ++ show img2) arr1 arr2)
+  (|*|) img1@(PDImage _) !img2            = compute img1 |*| img2
+  (|*|) !img1            img2@(PDImage _) = img1 |*| compute img2
+  (|*|) (PScalar px1)    !img2            = PTImage (singletonR px1) |*| img2
+  (|*|) !img1            (PScalar px2)    = img1 |*| PTImage (singletonR px2)
+  {-# INLINE (|*|) #-}
+
+  toManifest _ = error $ "RP.toManifest: Cannot convert generic Repa " ++
+                         "representation to a generic Vector."
+  {-# INLINE toManifest #-}
+
+
+
+----------------------
+-- Helper functions --
+----------------------
+
+sh2ix :: DIM2 -> (Int, Int)
+sh2ix (Z :. i :. j) = (i, j)
+{-# INLINE sh2ix #-}
+
+ix2sh :: (Int, Int) -> DIM2
+ix2sh !(i, j) = Z :. i :. j 
+{-# INLINE ix2sh #-}
+
+
+toRS :: Repr (RP r) ~ Repr (RS r) => Image (RP r) cs e -> Image (RS r) cs e
+toRS (PScalar px)  = SScalar px
+toRS (PDImage img) = SDImage img
+toRS (PTImage img) = STImage img
+
+toRP :: Repr (RP r) ~ Repr (RS r) => Image (RS r) cs e -> Image (RP r) cs e
+toRP (SScalar px)  = PScalar px
+toRP (SDImage img) = PDImage img
+toRP (STImage img) = PTImage img
+
+
+imapR
+  :: R.Source r2 b =>
+     ((Int, Int) -> b -> c) -> R.Array r2 DIM2 b -> R.Array R.D DIM2 c
+imapR f !arr = R.zipWith f (R.fromFunction (R.extent arr) sh2ix) arr
+
+
+-- | Combine two arrays, element-wise, with index aware operator. If the extent of
+-- the two array arguments differ, then the resulting array's extent is their
+-- intersection.
+izipWithR
+  :: (R.Source r2 t1, R.Source r1 t)
+  => ((Int, Int) -> t -> t1 -> c)
+  -> R.Array r1 DIM2 t
+  -> R.Array r2 DIM2 t1
+  -> R.Array R.D DIM2 c
+izipWithR f !arr1 !arr2 =
+  (R.traverse2 arr1 arr2 getNewDims getNewPx) where
+    getNewPx !getPx1 !getPx2 !sh = f (sh2ix sh) (getPx1 sh) (getPx2 sh)
+    getNewDims (Z :. m1 :. n1) (Z :. m2 :. n2) = Z :. min m1 m2 :. min n1 n2
+    {-# INLINE getNewPx #-}
+{-# INLINE izipWithR #-}
+
+
+traverseR
+  :: R.Source r c
+  => R.Array r DIM2 c
+  -> ((Int, Int) -> (Int, Int))
+  -> (((Int, Int) -> c) -> (Int, Int) -> b)
+  -> R.Array R.D DIM2 b
+traverseR !arr getNewDims getNewPx =
+  R.traverse arr (ix2sh . checkDims "traverseR" . getNewDims . sh2ix) getNewE
+  where
+    getNewE getPx = getNewPx (getPx . ix2sh) . sh2ix
+    {-# INLINE getNewE #-}
+{-# INLINE traverseR #-}
+
+traverse2R
+  :: (R.Source r2 c1, R.Source r1 c)
+  => R.Array r1 DIM2 c
+  -> R.Array r2 DIM2 c1
+  -> ((Int, Int) -> (Int, Int) -> (Int, Int))
+  -> (((Int, Int) -> c) -> ((Int, Int) -> c1) -> (Int, Int) -> c2)
+  -> R.Array R.D DIM2 c2
+traverse2R !arr1 !arr2 getNewDims getNewPx =
+  R.traverse2 arr1 arr2 getNewSh getNewE
+  where getNewE getPx1 getPx2 = getNewPx (getPx1 . ix2sh) (getPx2 . ix2sh) . sh2ix
+        {-# INLINE getNewE #-}
+        getNewSh !sh1 !sh2 =
+          ix2sh . checkDims "traverse2R" $ getNewDims (sh2ix sh1) (sh2ix sh2)
+        {-# INLINE getNewSh #-}
+{-# INLINE traverse2R #-}
+
+backpermuteR
+  :: R.Source r e
+  => R.Array r DIM2 e
+  -> (Int, Int)
+  -> ((Int, Int) -> (Int, Int))
+  -> R.Array R.D DIM2 e
+backpermuteR !arr newDims g =
+  R.backpermute
+    (ix2sh (checkDims "backpermuteR" newDims))
+    (ix2sh . g . sh2ix)
+    arr
+{-# INLINE backpermuteR #-}
+
+
+fromListsR :: (R.Target r e) => [[e]] -> R.Array r DIM2 e
+fromListsR ls =
+  if all (== n) (P.map length ls)
+    then R.fromList (Z :. m :. n) . concat $ ls
+    else error "fromListsR: Inner lists do not all have an equal length."
+  where
+    !(m, n) = checkDims "fromListsR" (length ls, length $ head ls)
+{-# INLINE fromListsR #-}
+
+
+
+multR
+  :: (ColorSpace cs e, IVU.Unbox (Components cs e), Num (Pixel cs e), R.Elt (Pixel cs e),
+      R.Target r (Pixel cs e), R.Source r (Pixel cs e))
+  => String -> R.Array r DIM2 (Pixel cs e) -> R.Array r DIM2 (Pixel cs e) -> R.Array R.D DIM2 (Pixel cs e)
+multR errMsg !arr1 !arr2 =
+  if n1 /= m2
+    then error $
+         "Inner dimensions of multiplied images must be the same, but received: " ++ errMsg
+    else R.fromFunction (Z :. m1 :. n2) $ getPx
+  where
+    (Z :. m1 :. n1) = R.extent arr1
+    (Z :. m2 :. n2) = R.extent arr2
+    getPx (Z :. i :. j) =
+      R.sumAllS
+        (R.slice arr1 (R.Any :. (i :: Int) :. R.All) R.*^
+         R.slice arr2 (R.Any :. (j :: Int)))
+    {-# INLINE getPx #-}
+{-# INLINE multR #-}
+
+
+singletonR :: (IVU.Unbox a, R.Target r a) => a -> R.Array r DIM2 a
+singletonR !px = R.computeS $ R.fromFunction (Z :. 1 :. 1) $ const px
+
+
+getDelayedS :: Array (RS r) cs e => Image (RS r) cs e -> R.Array R.D DIM2 (Pixel cs e)
+getDelayedS (STImage arr) = R.delay arr
+getDelayedS (SDImage arr) = arr
+getDelayedS (SScalar px)  = R.fromFunction (Z :. 1 :. 1) (const px)
+{-# INLINE getDelayedS #-}
+
+getDelayedP :: Array (RP r) cs e => Image (RP r) cs e -> R.Array R.D DIM2 (Pixel cs e)
+getDelayedP (PTImage arr) = R.delay arr
+getDelayedP (PDImage arr) = arr
+getDelayedP (PScalar px)  = R.fromFunction (Z :. 1 :. 1) (const px)
+{-# INLINE getDelayedP #-}
+
+
+instance R.Elt Bit where
+  touch (Bit w) = R.touch w
+  {-# INLINE touch #-}
+  
+  zero     = 0
+  {-# INLINE zero #-}
+  
+  one      = 1
+  {-# INLINE one #-}
+
+
+instance (ColorSpace cs e, R.Elt e, Num (Pixel cs e)) => R.Elt (Pixel cs e) where
+  touch !px = P.mapM_ (R.touch . getPxC px) (enumFrom (toEnum 0)) 
+  {-# INLINE touch #-}
+  
+  zero     = 0
+  {-# INLINE zero #-}
+  
+  one      = 1
+  {-# INLINE one #-}
+
+
+addIxArr
+  :: R.Source r2 b =>
+     R.Array r2 DIM2 b -> R.Array R.D DIM2 ((Int, Int), b)
+addIxArr !arr = R.zipWith (,) arrIx arr
+  where
+    !arrIx = R.fromFunction (R.extent arr) sh2ix
+{-# INLINE addIxArr #-}
+
+
+foldIxS
+  :: (R.Elt b, R.Source r2 b, IVU.Unbox b) =>
+     (b -> (Int, Int) -> b -> b) -> b -> R.Array r2 DIM2 b -> b
+foldIxS f !acc !arr = snd $ R.foldAllS g ((-1, 0), acc) arr'
+  where
+    !arr' = addIxArr arr
+    g (accIx@(-1, _), acc') !(ix, px) = (accIx, f acc' ix px)
+    g !(ix, px) (accIx@(-1, _), acc') = (accIx, f acc' ix px)
+    g (acc1Ix, _) (acc2Ix, _) =
+      error $ "foldIxS: Impossible happened. Received: " ++ show acc1Ix ++ " " ++ show acc2Ix
+    {-# INLINE g #-}
+{-# INLINE foldIxS #-}
+
+
+foldIxPUnboxed
+  :: (R.Source r2 b, IVU.Unbox b, R.Elt b, Functor m, Monad m)
+  => (b -> (Int, Int) -> b -> b) -> b -> R.Array r2 DIM2 b -> m b
+foldIxPUnboxed f !acc !arr = snd <$> R.foldAllP g ((-1, 0), acc) arr'
+  where
+    !arr' = addIxArr arr
+    g (accIx@(-1, _), acc') !(ix, px) = (accIx, f acc' ix px)
+    g !(ix, px) (accIx@(-1, _), acc') = (accIx, f acc' ix px)
+    g (acc1Ix, _) (acc2Ix, _) =
+      error $ "foldIxPUnboxed: Impossible happened. Received: " ++ show acc1Ix ++ " " ++ show acc2Ix
+    {-# INLINE g #-}
+{-# INLINE foldIxPUnboxed #-}
+
diff --git a/src/Graphics/Image/Interface/Repa/Helpers.hs b/src/Graphics/Image/Interface/Repa/Helpers.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/Image/Interface/Repa/Helpers.hs
@@ -0,0 +1,39 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE FlexibleContexts #-}
+module Graphics.Image.Interface.Repa.Helpers where
+
+import Data.Array.Repa
+import Data.Array.Repa.Repr.Partitioned
+import Data.Array.Repa.Repr.Undefined
+
+-- | Make a 2D windowed array from two others, one to produce the elements in
+--   the internal region, and one to produce elements in the border region. The
+--   two arrays must have the same extent.
+--
+makeWindowed
+        :: (Source r1 a, Source r2 a)
+        => DIM2                 -- ^ Extent of array.
+        -> ((Int, Int), (Int, Int))  -- ^ Window points.
+        -> Array r1 DIM2 a      -- ^ Array for internal elements.
+        -> Array r2 DIM2 a      -- ^ Array for border elements.
+        -> Array (P r1 (P r2 (P r2 (P r2 (P r2 X))))) DIM2 a
+makeWindowed sh@(_ :. m :. n) !((it, jt), (ib, jb)) arrWindow arrBorder =
+  checkDims `seq`
+  let inInternal (Z :. i :. j) = i >= it && i < ib && j >= jt && j < jb
+      {-# INLINE inInternal #-}
+      inBorder = not . inInternal
+      {-# INLINE inBorder #-}
+  in APart sh (Range (Z :. it :. jt) (Z :. (ib - it) :. (jb - jt)) inInternal) arrWindow $
+     APart sh (Range (Z :. 0 :.  0 ) (Z :. it        :. n        ) inBorder  ) arrBorder $
+     APart sh (Range (Z :. it :. 0 ) (Z :. (ib - it) :. jt       ) inBorder  ) arrBorder $
+     APart sh (Range (Z :. it :. jb) (Z :. (ib - it) :. (n - jb) ) inBorder  ) arrBorder $
+     APart sh (Range (Z :. ib :. 0 ) (Z :. (m - ib)  :. n        ) inBorder  ) arrBorder $
+     AUndefined sh
+  where
+    checkDims =
+      if extent arrWindow == extent arrBorder
+        then ()
+        else error
+               "makeWindowed: internal and border arrays have different extents"
+    {-# NOINLINE checkDims #-}
+{-# INLINE makeWindowed #-}
diff --git a/src/Graphics/Image/Interface/Repa/Internal.hs b/src/Graphics/Image/Interface/Repa/Internal.hs
deleted file mode 100644
--- a/src/Graphics/Image/Interface/Repa/Internal.hs
+++ /dev/null
@@ -1,490 +0,0 @@
-{-# OPTIONS -fno-warn-orphans #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE ViewPatterns #-}
--- |
--- Module      : Graphics.Image.Interface.Repa.Internal
--- Copyright   : (c) Alexey Kuleshevich 2016
--- License     : BSD3
--- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
--- Stability   : experimental
--- Portability : non-portable
---
-module Graphics.Image.Interface.Repa.Internal (
-  RP(..), RS(..),
-  fromRepaArrayS, fromRepaArrayP, toRepaArray
-  ) where
-
-#if MIN_VERSION_base(4,8,0)
-import Prelude hiding (map, zipWith, foldl, foldr, mapM, mapM_, read, traverse)
-#else
-import Prelude hiding (map, zipWith, foldl, foldr, mapM, mapM_, read)
-#endif
-import qualified Prelude as P (map, mapM_)
-import Graphics.Image.Interface
-import Graphics.Image.ColorSpace.Binary (Bit(..))
-import Graphics.Image.Interface.Vector.Unboxed
-       (VU(..), fromUnboxedVector, toUnboxedVector, checkDims)
-import Data.Array.Repa.Repr.Unboxed (Unbox)
-import qualified Data.Vector.Unboxed as V (singleton)
-
-import Data.Typeable (Typeable)
-import Data.Array.Repa.Index
-import qualified Data.Array.Repa as R 
-import qualified Data.Array.Repa.Eval as R (Elt(..), suspendedComputeP)
-
-
--- | Repa 'U'nboxed Array representation, which is computed in parallel.
-data RP = RP
-
--- | Repa 'U'nboxed Array representation, which is computed sequentially. 
-data RS = RS
-
-instance Show RP where
-  show _ = "RepaParallel"
-  
-instance Show RS where
-  show _ = "RepaSequential"
-
-
-
-instance Elt RS cs e => BaseArray RS cs e where
-  type Elt RS cs e = (ColorSpace cs, 
-                      R.Elt e, Unbox e, Num e, Typeable e,
-                      R.Elt (PixelElt cs e), Unbox (PixelElt cs e),
-                      R.Elt (Pixel cs e), Unbox (Pixel cs e))
-  
-  data Image RS cs e = SScalar !(Pixel cs e)
-                     | SUImage !(R.Array R.U R.DIM2 (Pixel cs e))
-                     | SDImage !(R.Array R.D R.DIM2 (Pixel cs e))
-                       
-  dims (SScalar _                          ) = (1, 1)
-  dims (SUImage (R.extent -> (Z :. m :. n))) = (m, n)
-  dims (SDImage (R.extent -> (Z :. m :. n))) = (m, n)
-  {-# INLINE dims #-}
-
-
-instance (BaseArray RS cs e) => Array RS cs e where
-
-  type Manifest RS = VU
-  
-  makeImage !(checkDims "RS.makeImage" -> (m, n)) !f =
-    SDImage $ R.fromFunction (Z :. m :. n) (f . sh2dims)
-  {-# INLINE makeImage #-}
-  
-  singleton = SScalar
-  {-# INLINE singleton #-}
-
-  index00 (SScalar px)  = px
-  index00 (SUImage arr) = R.index arr (Z :. 0 :. 0)
-  index00 (SDImage arr) = R.index arr (Z :. 0 :. 0)
-  {-# INLINE index00 #-}
-
-  map !f (SScalar px)  = SScalar (f px)
-  map !f (SUImage arr) = SDImage (R.map f arr)
-  map !f (SDImage arr) = SDImage (R.map f arr)
-  {-# INLINE map #-}
-
-  imap !f (SScalar px)  = SScalar (f (0, 0) px)
-  imap !f (SUImage arr) = SDImage (imapR f arr)
-  imap !f (SDImage arr) = SDImage (imapR f arr)
-  {-# INLINE imap #-}
-
-  zipWith f (SScalar px1)  (SScalar px2)  = SScalar (f px1 px2)
-  zipWith f (SScalar px1)  img2           = map (f px1) img2
-  zipWith f img1           (SScalar px2)  = map (`f` px2) img1
-  zipWith f img1           img2           =
-    SDImage (R.zipWith f (getDelayedS img1) (getDelayedS img2))
-  {-# INLINE zipWith #-}
-
-  izipWith f (SScalar px1)  (SScalar px2)  = SScalar (f (0, 0) px1 px2)
-  izipWith f (SScalar px1)  img2           = imap (`f` px1) img2
-  izipWith f img1           (SScalar px2)  = imap (\ !ix !px -> f ix px px2) img1
-  izipWith f img1           img2           =
-    SDImage (izipWithR f (getDelayedS img1) (getDelayedS img2))
-  {-# INLINE izipWith #-}
-  
-  -- traverse (SScalar px) getNewDims getNewPx =
-  --   makeImage (getNewDims (1, 1)) (getNewPx (const px))
-  traverse img          getNewDims getNewPx =
-    SDImage (traverseR (getDelayedS img) getNewDims getNewPx)
-  {-# INLINE traverse #-}
-
-  -- traverse2 (SScalar px1) (SScalar px2) getNewDims getNewPx =
-  --   makeImage (getNewDims (1, 1) (1, 1)) (getNewPx (const px1) (const px2))
-  traverse2 img1 img2 getNewDims getNewPx =
-    SDImage (traverse2R (getDelayedS img1) (getDelayedS img2) getNewDims getNewPx)
-  {-# INLINE traverse2 #-}
-
-  transpose (SDImage arr) = SDImage (R.transpose arr)
-  transpose (SUImage arr) = SDImage (R.transpose arr)
-  transpose !img          = img
-  {-# INLINE transpose #-}
-
-  -- backpermute !newDims _ (SScalar px) =
-  --   SDImage $ R.fromFunction (dims2sh $ checkDims "RS.backpermute" newDims) (const px)
-  backpermute !newDims g !img = SDImage (backpermuteR (getDelayedS img) newDims g)
-  {-# INLINE backpermute #-}
-
-  fromLists = SUImage . fromListsR
-  {-# INLINE fromLists #-}
-
-  fold f !px0 (SDImage arr) = R.foldAllS f px0 arr
-  fold f !px0 (SUImage arr) = R.foldAllS f px0 arr
-  fold f !px0 (SScalar px)  = f px0 px
-  {-# INLINE fold #-}
-
-  eq (SScalar px1) (SScalar px2) = px1 == px2
-  eq img1 img2 = R.equalsS (getDelayedS img1) (getDelayedS img2)
-  {-# INLINE eq #-}
-
-  compute img@(SScalar _) = img
-  compute img@(SUImage _) = img
-  compute (SDImage arr)   = SUImage $ R.computeS arr
-  {-# INLINE compute #-}
-
-  (SUImage arr1)   |*| (SUImage arr2)   = SDImage (multR arr1 arr2)
-  img1@(SDImage _) |*| img2             = compute img1 |*| img2
-  img1             |*| img2@(SDImage _) = img1 |*| compute img2
-  (SScalar px1)    |*| img2             = SUImage (singletonR px1) |*| img2
-  img1             |*| (SScalar px2)    = img1 |*| SUImage (singletonR px2)
-  {-# INLINE (|*|) #-}
-
-  toManifest img@(SUImage arr) = fromUnboxedVector (dims img) (R.toUnboxed arr)
-  toManifest (SScalar px)      = singleton px
-  toManifest img               = toManifest (compute img)
-  {-# INLINE toManifest #-}
-
----------------------
--- Parallel Arrays --
----------------------
-
-instance Elt RP cs e => BaseArray RP cs e where
-  type Elt RP cs e = (ColorSpace cs, 
-                      R.Elt e, Unbox e, Num e, Typeable e,
-                      R.Elt (PixelElt cs e), Unbox (PixelElt cs e),
-                      R.Elt (Pixel cs e), Unbox (Pixel cs e))
-  
-  data Image RP cs e = PScalar !(Pixel cs e)
-                     | PUImage !(R.Array R.U R.DIM2 (Pixel cs e))
-                     | PDImage !(R.Array R.D R.DIM2 (Pixel cs e))
-                       
-  dims (PScalar _                          ) = (1, 1)
-  dims (PUImage (R.extent -> (Z :. m :. n))) = (m, n)
-  dims (PDImage (R.extent -> (Z :. m :. n))) = (m, n)
-  {-# INLINE dims #-}
-
-
-instance (BaseArray RP cs e) => Array RP cs e where
-
-  type Manifest RP = VU
-  
-  makeImage !(checkDims "RP.makeImage" -> (m, n)) !f =
-    PDImage $ R.fromFunction (Z :. m :. n) (f . sh2dims)
-  {-# INLINE makeImage #-}
-  
-  singleton = PScalar
-  {-# INLINE singleton #-}
-
-  index00 (PScalar px)  = px
-  index00 (PUImage arr) = R.index arr (Z :. 0 :. 0)
-  index00 (PDImage arr) = R.index arr (Z :. 0 :. 0)
-  {-# INLINE index00 #-}
-
-  map !f (PScalar px)  = PScalar (f px)
-  map !f (PUImage arr) = PDImage (R.map f arr)
-  map !f (PDImage arr) = PDImage (R.map f arr)
-  {-# INLINE map #-}
-
-  imap !f (PScalar px)  = PScalar (f (0, 0) px)
-  imap !f (PUImage arr) = PDImage (imapR f arr)
-  imap !f (PDImage arr) = PDImage (imapR f arr)
-  {-# INLINE imap #-}
-
-  zipWith f (PScalar px1)  (PScalar px2)  = PScalar (f px1 px2)
-  zipWith f (PScalar px1)  img2           = map (f px1) img2
-  zipWith f img1           (PScalar px2)  = map (`f` px2) img1
-  zipWith f img1           img2           =
-    PDImage (R.zipWith f (getDelayedP img1) (getDelayedP img2))
-  {-# INLINE zipWith #-}
-
-  izipWith f (PScalar px1)  (PScalar px2)  = PScalar (f (0, 0) px1 px2)
-  izipWith f (PScalar px1)  img2           = imap (`f` px1) img2
-  izipWith f img1           (PScalar px2)  = imap (\ !ix !px -> f ix px px2) img1
-  izipWith f img1           img2           =
-    PDImage (izipWithR f (getDelayedP img1) (getDelayedP img2))
-  {-# INLINE izipWith #-}
-  
-  -- traverse (PScalar px) getNewDims getNewPx =
-  --   makeImage (getNewDims (1, 1)) (getNewPx (const px))
-  traverse img          getNewDims getNewPx =
-    PDImage (traverseR (getDelayedP img) getNewDims getNewPx)
-  {-# INLINE traverse #-}
-
-  -- traverse2 (PScalar px1) (PScalar px2) getNewDims getNewPx =
-  --   makeImage (getNewDims (1, 1) (1, 1)) (getNewPx (const px1) (const px2))
-  traverse2 img1 img2 getNewDims getNewPx =
-    PDImage (traverse2R (getDelayedP img1) (getDelayedP img2) getNewDims getNewPx)
-  {-# INLINE traverse2 #-}
-
-  transpose (PDImage arr) = PDImage (R.transpose arr)
-  transpose (PUImage arr) = PDImage (R.transpose arr)
-  transpose !img          = img
-  {-# INLINE transpose #-}
-
-  -- backpermute !newDims _ (PScalar px) =
-  --   PDImage $ R.fromFunction (dims2sh $ checkDims "RS.backpermute" newDims) (const px)
-  backpermute !newDims g !img = PDImage (backpermuteR (getDelayedP img) newDims g)
-  {-# INLINE backpermute #-}
-
-  fromLists = PUImage . fromListsR
-  {-# INLINE fromLists #-}
-
-  fold f !px0 (PDImage arr) = head $ R.foldAllP f px0 arr
-  fold f !px0 (PUImage arr) = head $ R.foldAllP f px0 arr
-  fold f !px0 (PScalar px)  = f px0 px
-  {-# INLINE fold #-}
-
-  eq (PScalar px1) (PScalar px2) = px1 == px2
-  eq img1 img2 = R.equalsS (getDelayedP img1) (getDelayedP img2)
-  {-# INLINE eq #-}
-
-  compute img@(PScalar _) = img
-  compute img@(PUImage _) = img
-  compute (PDImage arr)   = arrU `R.deepSeqArray` PUImage arrU
-    where arrU = R.suspendedComputeP arr
-  {-# INLINE compute #-}
-
-  (PUImage arr1)   |*| (PUImage arr2)   = PDImage (multR arr1 arr2)
-  img1@(PDImage _) |*| img2             = compute img1 |*| img2
-  img1             |*| img2@(PDImage _) = img1 |*| compute img2
-  (PScalar px1)    |*| img2             = PUImage (singletonR px1) |*| img2
-  img1             |*| (PScalar px2)    = img1 |*| PUImage (singletonR px2)
-  {-# INLINE (|*|) #-}
-
-  toManifest img@(PUImage arr) = fromUnboxedVector (dims img) (R.toUnboxed arr)
-  toManifest (PScalar px)      = singleton px
-  toManifest img               = toManifest (compute img)
-  {-# INLINE toManifest #-}
-
-
-----------------------
--- Helper functions --
-----------------------
-
-sh2dims :: DIM2 -> (Int, Int)
-sh2dims (Z :. i :. j) = (i, j)
-{-# INLINE sh2dims #-}
-
-dims2sh :: (Int, Int) -> DIM2
-dims2sh !(i, j) = Z :. i :. j 
-{-# INLINE dims2sh #-}
-
-
-imapR
-  :: R.Source r2 b =>
-     ((Int, Int) -> b -> c) -> R.Array r2 DIM2 b -> R.Array R.D DIM2 c
-imapR f arr = R.zipWith f (R.fromFunction (R.extent arr) sh2dims) arr
-
-
--- | Combine two arrays, element-wise, with index aware operator. If the extent of
--- the two array arguments differ, then the resulting array's extent is their
--- intersection.
-izipWithR
-  :: (R.Source r2 t1, R.Source r1 t)
-  => ((Int, Int) -> t -> t1 -> c)
-  -> R.Array r1 DIM2 t
-  -> R.Array r2 DIM2 t1
-  -> R.Array R.D DIM2 c
-izipWithR f arr1 arr2 =
-  (R.traverse2 arr1 arr2 getNewDims getNewPx) where
-    getNewPx !getPx1 !getPx2 !sh = f (sh2dims sh) (getPx1 sh) (getPx2 sh)
-    getNewDims (Z :. m1 :. n1) (Z :. m2 :. n2) = Z :. min m1 m2 :. min n1 n2
-    {-# INLINE getNewPx #-}
-{-# INLINE izipWithR #-}
-
-
-traverseR
-  :: R.Source r c
-  => R.Array r DIM2 c
-  -> ((Int, Int) -> (Int, Int))
-  -> (((Int, Int) -> c) -> (Int, Int) -> b)
-  -> R.Array R.D DIM2 b
-traverseR arr getNewDims getNewPx =
-  R.traverse arr (dims2sh . checkDims "traverseR" . getNewDims . sh2dims) getNewE
-  where
-    getNewE getPx = getNewPx (getPx . dims2sh) . sh2dims
-    {-# INLINE getNewE #-}
-{-# INLINE traverseR #-}
-
-traverse2R
-  :: (R.Source r2 c1, R.Source r1 c)
-  => R.Array r1 DIM2 c
-  -> R.Array r2 DIM2 c1
-  -> ((Int, Int) -> (Int, Int) -> (Int, Int))
-  -> (((Int, Int) -> c) -> ((Int, Int) -> c1) -> (Int, Int) -> c2)
-  -> R.Array R.D DIM2 c2
-traverse2R arr1 arr2 getNewDims getNewPx =
-  R.traverse2 arr1 arr2 getNewSh getNewE
-  where getNewE getPx1 getPx2 = getNewPx (getPx1 . dims2sh) (getPx2 . dims2sh) . sh2dims
-        {-# INLINE getNewE #-}
-        getNewSh !sh1 !sh2 =
-          dims2sh . checkDims "traverse2R" $ getNewDims (sh2dims sh1) (sh2dims sh2)
-        {-# INLINE getNewSh #-}
-{-# INLINE traverse2R #-}
-
-backpermuteR
-  :: R.Source r e
-  => R.Array r DIM2 e
-  -> (Int, Int)
-  -> ((Int, Int) -> (Int, Int))
-  -> R.Array R.D DIM2 e
-backpermuteR arr newDims g =
-  R.backpermute
-    (dims2sh (checkDims "backpermuteR" newDims))
-    (dims2sh . g . sh2dims)
-    arr
-{-# INLINE backpermuteR #-}
-
-
-fromListsR :: Unbox a => [[a]] -> R.Array R.U DIM2 a
-fromListsR ls =
-  if all (== n) (P.map length ls)
-    then R.fromListUnboxed (Z :. m :. n) . concat $ ls
-    else error "fromListsR: Inner lists do not all have an equal length."
-  where
-    !(m, n) = checkDims "fromListsR" (length ls, length $ head ls)
-{-# INLINE fromListsR #-}
-
-
-
-multR
-  :: (Num a, Unbox a, R.Elt a)
-  => R.Array R.U DIM2 a -> R.Array R.U DIM2 a -> R.Array R.D DIM2 a
-multR arr1 arr2 =
-  if n1 /= m2
-    then error $
-         "Inner dimensions of multiplied images must be the same, but received: " ++ ""
-         --show img1 ++ " X " ++ show img2
-    else R.fromFunction (Z :. m1 :. n2) $ getPx
-  where
-    (Z :. m1 :. n1) = R.extent arr1
-    (Z :. m2 :. n2) = R.extent arr2
-    getPx (Z :. i :. j) =
-      R.sumAllS
-        (R.slice arr1 (R.Any :. (i :: Int) :. R.All) R.*^
-         R.slice arr2 (R.Any :. (j :: Int)))
-    {-# INLINE getPx #-}
-{-# INLINE multR #-}
-
-
-singletonR :: Unbox e => e -> R.Array R.U DIM2 e
-singletonR px = R.fromUnboxed (Z :. 1 :. 1) $ V.singleton px
-
-
-getDelayedS :: Array RS cs e => Image RS cs e -> R.Array R.D DIM2 (Pixel cs e)
-getDelayedS (SUImage arr) = R.delay arr
-getDelayedS (SDImage arr) = arr
-getDelayedS (SScalar px)  = R.fromFunction (Z :. 1 :. 1) (const px)
-{-# INLINE getDelayedS #-}
-
-getDelayedP :: Array RP cs e => Image RP cs e -> R.Array R.D DIM2 (Pixel cs e)
-getDelayedP (PUImage arr) = R.delay arr
-getDelayedP (PDImage arr) = arr
-getDelayedP (PScalar px)  = R.fromFunction (Z :. 1 :. 1) (const px)
-{-# INLINE getDelayedP #-}
-
-
--- | Changes computation strategy. Will casue all fused operations to be computed.
-instance Exchangable RP RS where
-  
-  exchange _ (PScalar px)   = SScalar px
-  exchange _ (PUImage arr)  = SUImage arr
-  exchange r img@(PDImage _) = exchange r (compute img)
-  {-# INLINE exchange #-}
-
-
--- | Changes computation strategy. Will casue all fused operations to be computed.
-instance Exchangable RS RP where
-  
-  exchange _ (SScalar px)   = PScalar px
-  exchange _ (SUImage arr)  = PUImage arr
-  exchange r img@(SDImage _) = exchange r (compute img)
-  {-# INLINE exchange #-}
-
-
--- | O(1) - Changes to Repa representation.
-instance Exchangable VU RS where
-  exchange _ img@(dims -> (1, 1)) = singleton (img `index` (0, 0))
-  exchange _ img = SUImage . R.fromUnboxed (dims2sh $ dims img) . toUnboxedVector $ img
-  {-# INLINE exchange #-}
-
-
--- | O(1) - Changes to Repa representation.
-instance Exchangable VU RP where
-  exchange _ img@(dims -> (1, 1)) = singleton (img `index` (0, 0))
-  exchange _ img = PUImage . R.fromUnboxed (dims2sh $ dims img) . toUnboxedVector $ img
-  {-# INLINE exchange #-}
-
-
--- | O(1) - Changes to Vector representation.
-instance Exchangable RS VU where
-  exchange _ = toManifest
-  {-# INLINE exchange #-}
-
-
--- | O(1) - Changes to Vector representation.
-instance Exchangable RP VU where
-  exchange _ = toManifest
-  {-# INLINE exchange #-}
-
-
--- | Create a sequential image from a 2D Repa delayed array.
-fromRepaArrayS :: R.Array R.D DIM2 (Pixel cs e) -> Image RS cs e
-fromRepaArrayS = SDImage
-
-
--- | Create a parallel image from a 2D Repa delayed array.
-fromRepaArrayP :: R.Array R.D DIM2 (Pixel cs e) -> Image RP cs e
-fromRepaArrayP = PDImage
-
-
--- | Retrieve an underlying Repa array from an image.
-toRepaArray
-  :: (Array arr cs e, Array RS cs e, Exchangable arr RS)
-  => Image arr cs e -> R.Array R.U DIM2 (Pixel cs e)
-toRepaArray img =
-  case compute (exchange RS img) of
-    SUImage arr -> arr
-    SDImage arr -> R.computeS arr -- shouldn't occur, but for completeness
-    SScalar px -> R.computeS $ R.fromFunction (Z :. 1 :. 1) $ const px
-
-instance R.Elt Bit where
-  touch (Bit w) = R.touch w
-  {-# INLINE touch #-}
-  
-  zero     = 0
-  {-# INLINE zero #-}
-  
-  one      = 1
-  {-# INLINE one #-}
-
-
-instance (ColorSpace cs, R.Elt e, Num e) => R.Elt (Pixel cs e) where
-  touch !px = P.mapM_ (R.touch . getPxCh px) (enumFrom (toEnum 0)) 
-  {-# INLINE touch #-}
-  
-  zero     = 0
-  {-# INLINE zero #-}
-  
-  one      = 1
-  {-# INLINE one #-}
-
-
diff --git a/src/Graphics/Image/Interface/Repa/Storable.hs b/src/Graphics/Image/Interface/Repa/Storable.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/Image/Interface/Repa/Storable.hs
@@ -0,0 +1,275 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ViewPatterns #-}
+-- |
+-- Module      : Graphics.Image.Interface.Repa.Storable
+-- Copyright   : (c) Alexey Kuleshevich 2017
+-- License     : BSD3
+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
+-- Stability   : experimental
+-- Portability : non-portable
+--
+module Graphics.Image.Interface.Repa.Storable (
+  RSS(..), RPS(..), Image(..)
+  ) where
+
+import Prelude as P
+import Data.Array.Repa.Index
+import qualified Data.Array.Repa as R 
+import qualified Data.Array.Repa.Eval as R
+import qualified Data.Array.Repa.Repr.ForeignPtr as R
+import qualified Data.Vector.Storable as VS
+import Foreign.Storable
+
+import Graphics.Image.Interface as I
+import Graphics.Image.Interface.Repa.Generic
+import qualified Graphics.Image.Interface.Vector.Storable as IVS
+import qualified Graphics.Image.Interface.Vector.Unboxed as IVU
+
+
+
+-- | Repa Array representation backed by Storable Vector, which is computed sequentially. 
+data RSS = RSS
+
+-- | Repa Array representation backed by Storable Vector, which is computed in parallel.
+data RPS = RPS
+
+instance Show RSS where
+  show RSS = "RepaSequentialStorable"
+
+instance Show RPS where
+  show RPS = "RepaParallelStorable"
+  
+
+type instance Repr (RS IVS.S) = R.F
+
+type instance Repr (RP IVS.S) = R.F
+
+
+instance SuperClass RSS cs e => BaseArray RSS cs e where
+  type SuperClass RSS cs e =
+    (ColorSpace cs e, Num (Pixel cs e),
+     Storable e, Storable (Pixel cs e),
+     IVU.Unbox e, IVU.Unbox (Components cs e), 
+     R.Elt e, R.Elt (Pixel cs e))
+  
+  data Image RSS cs e = SSImage !(Image (RS IVS.S) cs e)
+                       
+  dims (SSImage img) = dims img
+  {-# INLINE dims #-}
+
+
+instance (BaseArray RSS cs e) => Array RSS cs e where
+
+  type Manifest RSS = IVS.VS
+  
+  makeImage !sz f = SSImage (makeImage sz f)
+  {-# INLINE makeImage #-}
+ 
+  makeImageWindowed !sz !w f = SSImage . makeImageWindowed sz w f
+  {-# INLINE makeImageWindowed #-}
+ 
+  singleton = SSImage . I.singleton
+  {-# INLINE singleton #-}
+
+  index00 (SSImage img) = index00 img
+  {-# INLINE index00 #-}
+
+  map f (SSImage img) = SSImage (I.map f img)
+  {-# INLINE map #-}
+
+  imap f (SSImage img) = SSImage (I.imap f img)
+  {-# INLINE imap #-}
+
+  zipWith f (SSImage img1) (SSImage img2) = SSImage (I.zipWith f img1 img2)
+  {-# INLINE zipWith #-}
+
+  izipWith f (SSImage img1) (SSImage img2) = SSImage (I.izipWith f img1 img2)
+  {-# INLINE izipWith #-}
+
+  traverse (SSImage img) f g = SSImage (I.traverse img f g)
+  {-# INLINE traverse #-}
+
+  traverse2 (SSImage img1) (SSImage img2) f g = SSImage (I.traverse2 img1 img2 f g)
+  {-# INLINE traverse2 #-}
+
+  transpose (SSImage img) = SSImage (I.transpose img)
+  {-# INLINE transpose #-}
+
+  backpermute !sz g (SSImage img) = SSImage (I.backpermute sz g img)
+  {-# INLINE backpermute #-}
+
+  fromLists = SSImage . fromLists
+  {-# INLINE fromLists #-}
+
+  fold f !px0 (SSImage img) = fold f px0 img
+  {-# INLINE fold #-}
+
+  foldIx f !px0 (SSImage img) = foldIx f px0 img
+  {-# INLINE foldIx #-}
+
+  eq (SSImage img1) (SSImage img2) = img1 == img2
+  {-# INLINE eq #-}
+
+  compute (SSImage img) = SSImage (compute img)
+  {-# INLINE compute #-}
+
+  (|*|) (SSImage img1) (SSImage img2) = SSImage (img1 |*| img2)
+  {-# INLINE (|*|) #-}
+
+  toManifest (SSImage (SScalar px)) = I.singleton px
+  toManifest (SSImage (STImage arr)) = fromRepaArrayStorable arr
+  toManifest !img = toManifest (compute img)
+  {-# INLINE toManifest #-}
+
+
+
+instance SuperClass RPS cs e => BaseArray RPS cs e where
+  type SuperClass RPS cs e =
+    (ColorSpace cs e, Num (Pixel cs e),
+     Storable e, Storable (Pixel cs e),
+     IVU.Unbox e, IVU.Unbox (Components cs e),
+     R.Elt e, R.Elt (Pixel cs e))
+  
+  data Image RPS cs e = PSImage !(Image (RP IVS.S) cs e)
+                       
+  dims (PSImage img) = dims img
+  {-# INLINE dims #-}
+
+
+instance (BaseArray RPS cs e) => Array RPS cs e where
+
+  type Manifest RPS = IVS.VS
+  
+  makeImage !sz f = PSImage (makeImage sz f)
+  {-# INLINE makeImage #-}
+ 
+  makeImageWindowed !sz !w f = PSImage . makeImageWindowed sz w f
+  {-# INLINE makeImageWindowed #-}
+ 
+  singleton = PSImage . singleton
+  {-# INLINE singleton #-}
+
+  index00 (PSImage img) = index00 img
+  {-# INLINE index00 #-}
+
+  map f (PSImage img) = PSImage (I.map f img)
+  {-# INLINE map #-}
+
+  imap f (PSImage img) = PSImage (I.imap f img)
+  {-# INLINE imap #-}
+
+  zipWith f (PSImage img1) (PSImage img2) = PSImage (I.zipWith f img1 img2)
+  {-# INLINE zipWith #-}
+
+  izipWith f (PSImage img1) (PSImage img2) = PSImage (I.izipWith f img1 img2)
+  {-# INLINE izipWith #-}
+
+  traverse (PSImage img) f g = PSImage (I.traverse img f g)
+  {-# INLINE traverse #-}
+
+  traverse2 (PSImage img1) (PSImage img2) f g = PSImage (I.traverse2 img1 img2 f g)
+  {-# INLINE traverse2 #-}
+
+  transpose (PSImage img) = PSImage (I.transpose img)
+  {-# INLINE transpose #-}
+
+  backpermute !sz g (PSImage img) = PSImage (backpermute sz g img)
+  {-# INLINE backpermute #-}
+
+  fromLists = PSImage . fromLists
+  {-# INLINE fromLists #-}
+
+  fold f !px0 (PSImage img) = I.fold f px0 img
+  {-# INLINE fold #-}
+
+  foldIx f !px0 (PSImage img) = I.foldIx f px0 img
+  {-# INLINE foldIx #-}
+
+  eq (PSImage img1) (PSImage img2) = img1 == img2
+  {-# INLINE eq #-}
+
+  compute (PSImage img) = PSImage (compute img)
+  {-# INLINE compute #-}
+
+  (|*|) (PSImage img1) (PSImage img2) = PSImage (img1 |*| img2)
+  {-# INLINE (|*|) #-}
+
+  toManifest (PSImage (PScalar px)) = singleton px
+  toManifest (PSImage (PTImage arr)) = fromRepaArrayStorable arr
+  toManifest !img = toManifest (compute img)
+  {-# INLINE toManifest #-}
+
+
+-- | Changes computation strategy. Will casue all fused operations to be computed.
+instance Exchangable RPS RSS where
+  
+  exchange _ (PSImage img) = SSImage (toRS img)
+  {-# INLINE exchange #-}
+
+
+-- | Changes computation strategy. Will casue all fused operations to be computed.
+instance Exchangable RSS RPS where
+  
+  exchange _ (SSImage img) = PSImage (toRP img)
+  {-# INLINE exchange #-}
+
+
+-- | O(1) - Changes to Repa representation.
+instance Exchangable IVS.VS RSS where
+  exchange _ !img@(dims -> (1, 1)) = singleton (index00 img)
+  exchange _ !img =
+    SSImage . STImage . toRepaArrayStorable $ img
+  {-# INLINE exchange #-}
+
+
+-- | O(1) - Changes to Repa representation.
+instance Exchangable IVS.VS RPS where
+  exchange _ !img@(dims -> (1, 1)) = singleton (index00 img)
+  exchange _ !img =
+    PSImage . PTImage . toRepaArrayStorable $ img
+  {-# INLINE exchange #-}
+
+
+-- | Changes to Vector representation.
+instance Exchangable RSS IVS.VS where
+  exchange _ = toManifest
+  {-# INLINE exchange #-}
+
+
+-- | Changes to Vector representation.
+instance Exchangable RPS IVS.VS where
+  exchange _ = toManifest
+  {-# INLINE exchange #-}
+
+
+fromRepaArrayStorable
+  :: forall cs e.
+     Array IVS.VS cs e
+  => R.Array R.F DIM2 (Pixel cs e) -> Image IVS.VS cs e
+fromRepaArrayStorable !arr =
+  IVS.fromStorableVector (sh2ix (R.extent arr)) $
+  VS.unsafeFromForeignPtr0 (R.toForeignPtr arr) sz
+  where
+    !sz = sizeOf (undefined :: Pixel cs e) * m * n
+    (Z :. m :. n) = R.extent arr
+
+
+toRepaArrayStorable
+  :: forall cs e.
+     Array IVS.VS cs e
+  => Image IVS.VS cs e -> R.Array R.F DIM2 (Pixel cs e)
+toRepaArrayStorable !img
+  | sz == sz' = R.fromForeignPtr (ix2sh (dims img)) fp
+  | otherwise = error $ "toRepaArrayStorable: (impossible) Vector size mismatch: " ++
+                show sz ++ " vs " ++ show sz'
+  where
+    !(fp, sz) = VS.unsafeToForeignPtr0 $ IVS.toStorableVector img
+    !sz' = sizeOf (undefined :: Pixel cs e) * m * n
+    !(m, n) = dims img
diff --git a/src/Graphics/Image/Interface/Repa/Unboxed.hs b/src/Graphics/Image/Interface/Repa/Unboxed.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/Image/Interface/Repa/Unboxed.hs
@@ -0,0 +1,243 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ViewPatterns #-}
+-- |
+-- Module      : Graphics.Image.Interface.Repa.Unboxed
+-- Copyright   : (c) Alexey Kuleshevich 2017
+-- License     : BSD3
+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
+-- Stability   : experimental
+-- Portability : non-portable
+--
+module Graphics.Image.Interface.Repa.Unboxed (
+  RSU(..), RPU(..), Image(..)
+  ) where
+
+import Prelude as P
+import qualified Data.Array.Repa as R 
+import qualified Data.Array.Repa.Eval as R
+
+import Graphics.Image.Interface as I
+import Graphics.Image.Interface.Repa.Generic
+import qualified Graphics.Image.Interface.Vector.Unboxed as IVU
+
+
+-- | Repa Array representation backed by Unboxed Vector, which is computed sequentially. 
+data RSU = RSU
+
+-- | Repa Array representation backed by Unboxed Vector, which is computed in parallel.
+data RPU = RPU
+
+instance Show RSU where
+  show RSU = "RepaSequentialUnboxed"
+
+instance Show RPU where
+  show RPU = "RepaParallelUnboxed"
+  
+
+type instance Repr (RS IVU.U) = R.U
+
+type instance Repr (RP IVU.U) = R.U
+
+
+instance SuperClass RSU cs e => BaseArray RSU cs e where
+  type SuperClass RSU cs e =
+    (ColorSpace cs e, Num (Pixel cs e),
+     IVU.Unbox e, IVU.Unbox (Components cs e),
+     R.Elt e, R.Elt (Pixel cs e))
+  
+  data Image RSU cs e = SUImage !(Image (RS IVU.U) cs e)
+                       
+  dims (SUImage img) = dims img
+  {-# INLINE dims #-}
+
+
+instance (BaseArray RSU cs e) => Array RSU cs e where
+
+  type Manifest RSU = IVU.VU
+  
+  makeImage !sz f = SUImage (makeImage sz f)
+  {-# INLINE makeImage #-}
+ 
+  makeImageWindowed !sz !w f = SUImage . makeImageWindowed sz w f
+  {-# INLINE makeImageWindowed #-}
+ 
+  singleton = SUImage . singleton
+  {-# INLINE singleton #-}
+
+  index00 (SUImage img) = index00 img
+  {-# INLINE index00 #-}
+
+  map f (SUImage img) = SUImage (I.map f img)
+  {-# INLINE map #-}
+
+  imap f (SUImage img) = SUImage (I.imap f img)
+  {-# INLINE imap #-}
+
+  zipWith f (SUImage img1) (SUImage img2) = SUImage (I.zipWith f img1 img2)
+  {-# INLINE zipWith #-}
+
+  izipWith f (SUImage img1) (SUImage img2) = SUImage (I.izipWith f img1 img2)
+  {-# INLINE izipWith #-}
+
+  traverse (SUImage img) f g = SUImage (I.traverse img f g)
+  {-# INLINE traverse #-}
+
+  traverse2 (SUImage img1) (SUImage img2) f g = SUImage (I.traverse2 img1 img2 f g)
+  {-# INLINE traverse2 #-}
+
+  transpose (SUImage img) = SUImage (I.transpose img)
+  {-# INLINE transpose #-}
+
+  backpermute !sz g (SUImage img) = SUImage (backpermute sz g img)
+  {-# INLINE backpermute #-}
+
+  fromLists = SUImage . fromLists
+  {-# INLINE fromLists #-}
+
+  fold f !px0 (SUImage img) = fold f px0 img
+  {-# INLINE fold #-}
+
+  foldIx f !px0 (SUImage img) = foldIx f px0 img
+  {-# INLINE foldIx #-}
+
+  eq (SUImage img1) (SUImage img2) = img1 == img2
+  {-# INLINE eq #-}
+
+  compute (SUImage img) = SUImage (compute img)
+  {-# INLINE compute #-}
+
+  (|*|) (SUImage img1) (SUImage img2) = SUImage (img1 |*| img2)
+  {-# INLINE (|*|) #-}
+
+  toManifest (SUImage (SScalar px)) = singleton px
+  toManifest (SUImage (STImage arr)) =
+    IVU.fromUnboxedVector (sh2ix (R.extent arr)) (R.toUnboxed arr)
+  toManifest !img = toManifest (compute img)
+  {-# INLINE toManifest #-}
+
+
+
+instance SuperClass RPU cs e => BaseArray RPU cs e where
+  type SuperClass RPU cs e =
+    (ColorSpace cs e, Num (Pixel cs e),
+     IVU.Unbox e, IVU.Unbox (Components cs e),
+     R.Elt e, R.Elt (Pixel cs e))
+  
+  data Image RPU cs e = PUImage !(Image (RP IVU.U) cs e)
+                       
+  dims (PUImage img) = dims img
+  {-# INLINE dims #-}
+
+
+instance (BaseArray RPU cs e) => Array RPU cs e where
+
+  type Manifest RPU = IVU.VU
+  
+  makeImage !sz f = PUImage (makeImage sz f)
+  {-# INLINE makeImage #-}
+ 
+  makeImageWindowed !sz !w f = PUImage . makeImageWindowed sz w f
+  {-# INLINE makeImageWindowed #-}
+ 
+  singleton = PUImage . singleton
+  {-# INLINE singleton #-}
+
+  index00 (PUImage img) = index00 img
+  {-# INLINE index00 #-}
+
+  map f (PUImage img) = PUImage (I.map f img)
+  {-# INLINE map #-}
+
+  imap f (PUImage img) = PUImage (I.imap f img)
+  {-# INLINE imap #-}
+
+  zipWith f (PUImage img1) (PUImage img2) = PUImage (I.zipWith f img1 img2)
+  {-# INLINE zipWith #-}
+
+  izipWith f (PUImage img1) (PUImage img2) = PUImage (I.izipWith f img1 img2)
+  {-# INLINE izipWith #-}
+
+  traverse (PUImage img) f g = PUImage (I.traverse img f g)
+  {-# INLINE traverse #-}
+
+  traverse2 (PUImage img1) (PUImage img2) f g = PUImage (I.traverse2 img1 img2 f g)
+  {-# INLINE traverse2 #-}
+
+  transpose (PUImage img) = PUImage (I.transpose img)
+  {-# INLINE transpose #-}
+
+  backpermute !sz g (PUImage img) = PUImage (backpermute sz g img)
+  {-# INLINE backpermute #-}
+
+  fromLists = PUImage . fromLists
+  {-# INLINE fromLists #-}
+
+  fold f !px0 (PUImage img) = I.fold f px0 img
+  {-# INLINE fold #-}
+
+  foldIx f !px0 (PUImage img) = I.foldIx f px0 img
+  {-# INLINE foldIx #-}
+
+  eq (PUImage img1) (PUImage img2) = img1 == img2
+  {-# INLINE eq #-}
+
+  compute (PUImage img) = PUImage (compute img)
+  {-# INLINE compute #-}
+
+  (|*|) (PUImage img1) (PUImage img2) = PUImage (img1 |*| img2)
+  {-# INLINE (|*|) #-}
+
+  toManifest (PUImage (PScalar px)) = singleton px
+  toManifest (PUImage (PTImage arr)) =
+    IVU.fromUnboxedVector (sh2ix (R.extent arr)) (R.toUnboxed arr)
+  toManifest !img = toManifest (compute img)
+  {-# INLINE toManifest #-}
+
+
+-- | Changes computation strategy. Will casue all fused operations to be computed.
+instance Exchangable RPU RSU where
+  
+  exchange _ (PUImage img)  = SUImage (toRS img)
+  {-# INLINE exchange #-}
+
+
+-- | Changes computation strategy. Will casue all fused operations to be computed.
+instance Exchangable RSU RPU where
+  
+  exchange _ (SUImage img)  = PUImage (toRP img)
+  {-# INLINE exchange #-}
+
+
+-- | O(1) - Changes to Repa representation.
+instance Exchangable IVU.VU RSU where
+  exchange _ img@(dims -> (1, 1)) = singleton (index00 img)
+  exchange _ img =
+    SUImage . STImage . R.fromUnboxed (ix2sh $ dims img) . IVU.toUnboxedVector $ img
+  {-# INLINE exchange #-}
+
+
+-- | O(1) - Changes to Repa representation.
+instance Exchangable IVU.VU RPU where
+  exchange _ img@(dims -> (1, 1)) = singleton (index00 img)
+  exchange _ img =
+    PUImage . PTImage . R.fromUnboxed (ix2sh $ dims img) . IVU.toUnboxedVector $ img
+  {-# INLINE exchange #-}
+
+
+-- | Changes to Vector representation.
+instance Exchangable RSU IVU.VU where
+  exchange _ = toManifest
+  {-# INLINE exchange #-}
+
+
+-- | Changes to Vector representation.
+instance Exchangable RPU IVU.VU where
+  exchange _ = toManifest
+  {-# INLINE exchange #-}
diff --git a/src/Graphics/Image/Interface/Vector.hs b/src/Graphics/Image/Interface/Vector.hs
--- a/src/Graphics/Image/Interface/Vector.hs
+++ b/src/Graphics/Image/Interface/Vector.hs
@@ -1,66 +1,35 @@
-{-# LANGUAGE FlexibleContexts #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 -- |
 -- Module      : Graphics.Image.Interface.Vector
--- Copyright   : (c) Alexey Kuleshevich 2016
+-- Copyright   : (c) Alexey Kuleshevich 2017
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
 -- Portability : non-portable
 --
 module Graphics.Image.Interface.Vector (
-  -- * Construction
-  makeImage, fromLists, fromUnboxedVector, toUnboxedVector,
   -- * Representation
-  VU(..),
+  VU(..), VS(..),
+  -- * Conversion
+  fromUnboxedVector, toUnboxedVector,
+  fromStorableVector, toStorableVector,
   -- * Linear index conversion
   toIx, fromIx
   ) where
 
-import Graphics.Image.Interface hiding (makeImage, fromLists)
-import qualified Graphics.Image.Interface as I (makeImage, fromLists)
+import Data.Vector as V (convert)
+import Graphics.Image.Interface
+import Graphics.Image.Interface.Vector.Generic
 import Graphics.Image.Interface.Vector.Unboxed
+import Graphics.Image.Interface.Vector.Storable
 
 
--- | Create an image with 'VU' (Vector Unboxed) representation and pixels of 'Double'
--- precision. Note, that it is essential for 'Double' precision pixels to keep values
--- normalized in the @[0, 1]@ range in order for an image to be written to file
--- properly.
---
--- >>> let grad_gray = makeImage (200, 200) (\(i, j) -> PixelY (fromIntegral i)/200 * (fromIntegral j)/200)
---
--- Because all 'Pixel's and 'Image's are installed into 'Num', above is equivalent to:
---
--- >>> let grad_gray = makeImage (200, 200) (\(i, j) -> PixelY $ fromIntegral (i*j)) / (200*200)
--- >>> writeImage "images/grad_gray.png" grad_gray
---
--- Creating color images is just as easy.
---
--- >>> let grad_color = makeImage (200, 200) (\(i, j) -> PixelRGB (fromIntegral i) (fromIntegral j) (fromIntegral (i + j))) / 400
--- >>> writeImage "images/grad_color.png" grad_color
---
--- <<images/grad_gray.png>> <<images/grad_color.png>>
---
-makeImage :: Array VU cs Double =>
-             (Int, Int) -- ^ (@m@ rows, @n@ columns) - dimensions of a new image.
-          -> ((Int, Int) -> Pixel cs Double)
-             -- ^ A function that takes (@i@-th row, and @j@-th column) as an argument
-             -- and returns a pixel for that location.
-          -> Image VU cs Double
-makeImage = I.makeImage
-{-# INLINE makeImage #-}
+instance Exchangable VU VS where
+  exchange _ (VUImage (VScalar px))   = VSImage (VScalar px)
+  exchange _ (VUImage (VImage m n v)) = VSImage (VImage m n (V.convert v))
 
 
--- | Construct an image from a nested rectangular shaped list of pixels.
--- Length of an outer list will constitute @m@ rows, while the length of inner lists -
--- @n@ columns. All of the inner lists must be the same length and greater than @0@.
---
--- >>> fromLists [[PixelY (fromIntegral (i*j) / 60000) | j <- [1..300]] | i <- [1..200]]
--- <Image VectorUnboxed Y (Double): 200x300>
---
--- <<images/grad_fromLists.png>>
---
-fromLists :: Array VU cs e =>
-             [[Pixel cs e]]
-          -> Image VU cs e
-fromLists = I.fromLists
-{-# INLINE fromLists #-}
+instance Exchangable VS VU where
+  exchange _ (VSImage (VScalar px))   = VUImage (VScalar px)
+  exchange _ (VSImage (VImage m n v)) = VUImage (VImage m n (V.convert v))
diff --git a/src/Graphics/Image/Interface/Vector/Generic.hs b/src/Graphics/Image/Interface/Vector/Generic.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/Image/Interface/Vector/Generic.hs
@@ -0,0 +1,292 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ViewPatterns #-}
+-- |
+-- Module      : Graphics.Image.Interface.Vector.Generic
+-- Copyright   : (c) Alexey Kuleshevich 2017
+-- License     : BSD3
+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
+-- Stability   : experimental
+-- Portability : non-portable
+--
+module Graphics.Image.Interface.Vector.Generic (
+  V(..), Repr, Image(..), fromVector, toVector
+  ) where
+
+import Prelude hiding (map, zipWith)
+import qualified Prelude as P (map)
+import Control.DeepSeq (NFData, deepseq)
+import Control.Monad
+import Control.Monad.ST
+#if !MIN_VERSION_base(4,8,0)
+import Data.Functor
+#endif
+import Data.Primitive.MutVar
+import qualified Data.Vector.Unboxed as VU
+import qualified Data.Vector.Generic as VG
+import qualified Data.Vector.Generic.Mutable as MVG
+import Graphics.Image.Interface as I
+
+-- | Generic 'Vector' representation.
+data V r = V r
+
+type family Repr arr :: * -> *
+
+instance Show r => Show (V r) where
+  show r = "Vector " ++ show r
+
+instance SuperClass (V r) cs e => BaseArray (V r) cs e where
+  type SuperClass (V r) cs e = (Show r, ColorSpace cs e, Num (Pixel cs e),
+                                VG.Vector (Repr (V r)) (Pixel cs e), VG.Vector (Repr (V r)) Int,
+                                VG.Vector (Repr (V r)) Bool, NFData ((Repr (V r)) (Pixel cs e)))
+
+  data Image (V r) cs e = VScalar !(Pixel cs e)
+                        | VImage {-# UNPACK #-} !Int
+                                 {-# UNPACK #-} !Int
+                                 !((Repr (V r)) (Pixel cs e))
+
+  dims (VImage m n _) = (m, n)
+  dims (VScalar _)    = (1, 1)
+  {-# INLINE dims #-}
+
+
+instance (MArray (V r) cs e, BaseArray (V r) cs e) => Array (V r) cs e where
+
+  type Manifest (V r) = V r
+
+  makeImage !(checkDims "(V r).makeImage" -> (m, n)) f =
+    VImage m n $ VG.generate (m * n) (f . toIx n)
+  {-# INLINE makeImage #-}
+
+  makeImageWindowed sz !((it, jt), (ib, jb)) getWindowPx getBorderPx =
+    VImage m n $ VG.create generate where
+      !(m, n) = checkDims "(V r).makeImageWindowed" sz
+      nestedLoop :: (VG.Mutable (Repr (V r))) s (Pixel cs e)
+                 -> ((Int, Int) -> Pixel cs e)
+                 -> Int -> Int -> Int -> Int
+                 -> ST s ()
+      nestedLoop !mv !getPx !fi !fj !ti !tj = do
+        VU.forM_ (VU.enumFromN fi (ti-1)) $ \i ->
+          VU.forM_ (VU.enumFromN fj (tj-1)) $ \j ->
+            MVG.write mv (fromIx n (i,j)) (getPx (i, j))
+      {-# INLINE nestedLoop #-}
+      generate :: ST s ((VG.Mutable (Repr (V r))) s (Pixel cs e))
+      generate = do
+        mv <- MVG.unsafeNew (m*n)
+        nestedLoop mv getBorderPx 0 0 ib n
+        nestedLoop mv getBorderPx it 0 ib jt
+        nestedLoop mv getWindowPx it jt ib jb
+        nestedLoop mv getBorderPx it jb ib n
+        nestedLoop mv getBorderPx ib 0 m n
+        return mv
+      {-# INLINE generate #-}
+  {-# INLINE makeImageWindowed #-}
+  
+  singleton = VScalar
+  {-# INLINE singleton #-}
+
+  index00 (VScalar px) = px
+  index00 (VImage _ _ v) = v VG.! 0
+  {-# INLINE index00 #-}
+  
+  map f (VScalar px)   = VScalar (f px)
+  map f (VImage m n v) = VImage m n (VG.map f v)
+  {-# INLINE map #-}
+
+  imap f (VScalar px)   = VScalar (f (0, 0) px)
+  imap f (VImage m n v) = VImage m n (VG.imap (\ !k !px -> f (toIx n k) px) v)
+  {-# INLINE imap #-}
+  
+  zipWith f (VScalar px1) (VScalar px2)    = VScalar (f px1 px2)
+  zipWith f (VScalar px1) (VImage m n v2) = VImage m n (VG.map (f px1) v2)
+  zipWith f (VImage m n v1) (VScalar px2) = VImage m n (VG.map (`f` px2) v1)
+  zipWith f img1@(VImage m1 n1 v1) img2@(VImage m2 n2 v2) =
+    if m1 /= m2 || n1 /= n2
+    then error ("zipWith: Images must be of the same dimensions, received: "++
+                show img1++" and "++show img2++".")
+    else VImage m1 n1 (VG.zipWith f v1 v2)
+  {-# INLINE zipWith #-}
+
+  izipWith f (VScalar px1) (VScalar px2)    = VScalar (f (0, 0) px1 px2)
+  izipWith f (VScalar px1) (VImage m n v2) =
+    VImage m n (VG.imap (\ !k !px2 -> f (toIx n k) px1 px2) v2)
+  izipWith f (VImage m n v1) (VScalar px2) =
+    VImage m n (VG.imap (\ !k !px1 -> f (toIx n k) px1 px2) v1)
+  izipWith f img1@(VImage m1 n1 v1) img2@(VImage m2 n2 v2) =
+    if m1 /= m2 || n1 /= n2
+    then error ("izipWith: Images must be of the same dimensions, received: "++
+                show img1++" and "++show img2++".")
+    else VImage m1 n1 (VG.izipWith (\ !k !px1 !px2 -> f (toIx n1 k) px1 px2) v1 v2)
+  {-# INLINE izipWith #-}
+
+  traverse !img getNewDims getNewPx = makeImage (getNewDims (dims img)) (getNewPx (index img))
+  {-# INLINE traverse #-}
+
+  traverse2 !img1 !img2 getNewDims getNewPx =
+    makeImage (getNewDims (dims img1) (dims img2)) (getNewPx (index img1) (index img2))
+  {-# INLINE traverse2 #-}
+
+  -- TODO: switch directly to VG.unsafeBackpermute (no need to check ixs)
+  transpose !img = backpermute (n, m) movePx img where
+    !(m, n) = dims img
+    movePx !(i, j) = (j, i)
+    {-# INLINE movePx #-}
+  {-# INLINE transpose #-}
+
+  -- TODO: add index verification and switch to VG.unsafeBackpermute
+  backpermute !(checkDims "(V r).backpermute" -> (m, n)) !f (VImage _ n' v) =
+    VImage m n $ VG.backpermute v $ VG.generate (m*n) (fromIx n' . f . toIx n)
+  backpermute !sz _ (VScalar px) = makeImage sz (const px)
+  {-# INLINE backpermute #-}
+  
+  fromLists !ls = if all (== n) (P.map length ls)
+                  then VImage m n . VG.fromList . concat $ ls
+                  else error "fromLists: Inner lists are of different lengths."
+    where
+      !(m, n) = checkDims "(V r).fromLists" (length ls, length $ head ls)
+  {-# INLINE fromLists #-}
+
+  fold !f !px0 (VImage _ _ v) = VG.foldl' f px0 v
+  fold !f !px0 (VScalar px)    = f px0 px
+  {-# INLINE fold #-}
+
+  foldIx !f !px0 (VImage _ n v) = VG.ifoldl' f' px0 v where
+    f' !acc !k !px = f acc (toIx n k) px
+  foldIx !f !px0 (VScalar px)    = f px0 (0,0) px
+  {-# INLINE foldIx #-}
+
+  (|*|) img1@(VImage m1 n1 v1) !img2@VImage {} =
+    if n1 /= m2 
+    then error ("Inner dimensions of multiplying images must be the same, but received: "++
+                show img1 ++" X "++ show img2)
+    else
+      makeImage (m1, n2) getPx where
+        VImage n2 m2 v2 = transpose img2
+        getPx !(i, j) = VG.sum $ VG.zipWith (*) (VG.slice (i*n1) n1 v1) (VG.slice (j*m2) m2 v2)
+        {-# INLINE getPx #-}
+  (|*|) (VScalar px1) (VScalar px2) = VScalar (px1 * px2)
+  (|*|) _ _ = error "Scalar Images cannot be multiplied."
+  {-# INLINE (|*|) #-}
+
+  eq (VImage m1 n1 v1) (VImage m2 n2 v2) =
+    m1 == m2 && n1 == n2 && VG.all id (VG.zipWith (==) v1 v2)
+  eq (VScalar px1)           (VScalar px2) = px1 == px2
+  eq (VImage 1 1 v1) (VScalar px2) = v1 VG.! 0 == px2
+  eq (VScalar px1) (VImage 1 1 v2) = v2 VG.! 0 == px1
+  eq _ _ = False
+  {-# INLINE eq #-}
+
+  compute (VImage m n v) = m `seq` n `seq` v `deepseq` (VImage m n v)
+  compute (VScalar px)    = px `seq` (VScalar px)
+  {-# INLINE compute #-}
+
+  toManifest = id
+  {-# INLINE toManifest #-}
+
+
+instance BaseArray (V r) cs e => MArray (V r) cs e where
+  
+  data MImage s (V r) cs e = MVImage !Int !Int ((VG.Mutable (Repr (V r))) s (Pixel cs e))
+                            | MVScalar (MutVar s (Pixel cs e))
+                              
+
+  unsafeIndex (VImage _ n v) !ix = VG.unsafeIndex v (fromIx n ix)
+  unsafeIndex (VScalar px)     _ = px
+  {-# INLINE unsafeIndex #-}
+
+  deepSeqImage (VImage m n v) = m `seq` n `seq` deepseq v
+  deepSeqImage (VScalar px)   = seq px
+  {-# INLINE deepSeqImage #-}
+
+  foldl f !a (VImage _ _ v) = VG.foldl' f a v
+  foldl f !a (VScalar px)   = f a px
+
+  foldr f !a (VImage _ _ v) = VG.foldr' f a v
+  foldr f !a (VScalar px)   = f px a
+  {-# INLINE foldr #-}
+
+  makeImageM !(checkDims "(V r).makeImageM" -> (m, n)) !f =
+    VImage m n <$> VG.generateM (m * n) (f . toIx n)
+  {-# INLINE makeImageM #-}
+
+  mapM f (VImage m n v) = VImage m n <$> VG.mapM f v
+  mapM f (VScalar px)   = VScalar <$> f px
+  {-# INLINE mapM #-}
+
+  mapM_ f (VImage _ _ v) = VG.mapM_ f v
+  mapM_ f (VScalar px)    = void $ f px
+  {-# INLINE mapM_ #-}
+
+  foldM f !a (VImage _ _ v) = VG.foldM' f a v
+  foldM f !a (VScalar px)    = f a px
+  {-# INLINE foldM #-}
+
+  foldM_ f !a (VImage _ _ v) = VG.foldM'_ f a v
+  foldM_ f !a (VScalar px)    = void $ f a px
+  {-# INLINE foldM_ #-}
+
+
+  mdims (MVImage m n _) = (m, n)
+  mdims (MVScalar _)    = (1, 1)
+  {-# INLINE mdims #-}
+
+  thaw (VImage m n v) = MVImage m n <$> VG.thaw v
+  thaw (VScalar px)   = MVScalar <$> newMutVar px
+  {-# INLINE thaw #-}
+
+  freeze (MVImage m n mv) = VImage m n <$> VG.freeze mv
+  freeze (MVScalar mpx)    = VScalar <$> readMutVar mpx
+  {-# INLINE freeze #-}
+
+  new (m, n) = MVImage m n <$> MVG.new (m*n)
+  {-# INLINE new #-}
+
+  read (MVImage _ n mv) !ix = MVG.read mv (fromIx n ix)
+  read (MVScalar mpx)   !ix = do
+    unless ((0, 0) == ix) $ error $ "Index out of bounds: " ++ show ix
+    readMutVar mpx
+  {-# INLINE read #-}
+
+  write (MVImage _ n mv) !ix !px = MVG.write mv (fromIx n ix) px
+  write (MVScalar mv)    !ix !px = do
+    unless ((0, 0) == ix) $ error $ "Index out of bounds: " ++ show ix
+    writeMutVar mv px
+  {-# INLINE write #-}
+
+  swap (MVImage _ n mv) !ix1 !ix2 = MVG.swap mv (fromIx n ix1) (fromIx n ix2)
+  swap _                _    _    = return ()
+  {-# INLINE swap #-}
+
+
+-- | Convert an image to a flattened  'Vector'. It is a __O(1)__ opeartion.
+--
+-- >>> toVector $ makeImage (3, 2) (\(i, j) -> PixelY $ fromIntegral (i+j))
+-- fromList [<Luma:(0.0)>,<Luma:(1.0)>,<Luma:(1.0)>,<Luma:(2.0)>,<Luma:(2.0)>,<Luma:(3.0)>]
+--
+toVector :: VG.Vector (Repr (V r)) (Pixel cs e) => Image (V r) cs e -> (Repr (V r)) (Pixel cs e)
+toVector (VImage _ _ v) = v
+toVector (VScalar px)   = VG.singleton px
+{-# INLINE toVector #-}
+
+
+-- | Construct a two dimensional image with @m@ rows and @n@ columns from a flat
+--  'Vector' of length @k@. It is a __O(1)__ opeartion. Make sure that @m * n = k@.
+--
+-- >>> fromVector (200, 300) $ generate 60000 (\i -> PixelY $ fromIntegral i / 60000)
+-- <Image Vector Luma: 200x300>
+--
+-- <<images/grad_fromVector.png>>
+-- 
+fromVector :: (Array (V r) cs e, VG.Vector (Repr (V r)) (Pixel cs e)) => (Int, Int) -> (Repr (V r)) (Pixel cs e) -> Image (V r) cs e
+fromVector !(m, n) !v
+  | m * n == VG.length v = VImage m n v
+  | otherwise = error "fromVector: m * n doesn't equal the length of a Vector."
+{-# INLINE fromVector #-}
diff --git a/src/Graphics/Image/Interface/Vector/Storable.hs b/src/Graphics/Image/Interface/Vector/Storable.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/Image/Interface/Vector/Storable.hs
@@ -0,0 +1,196 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ViewPatterns #-}
+-- |
+-- Module      : Graphics.Image.Interface.Vector.Storable
+-- Copyright   : (c) Alexey Kuleshevich 2017
+-- License     : BSD3
+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
+-- Stability   : experimental
+-- Portability : non-portable
+--
+module Graphics.Image.Interface.Vector.Storable (
+  VS(..), S, Image(..), fromStorableVector, toStorableVector, fromIx, toIx, checkDims
+  ) where
+
+import Prelude hiding (map, zipWith)
+#if !MIN_VERSION_base(4,8,0)
+import Data.Functor
+#endif
+import qualified Data.Vector.Storable as VS
+import Graphics.Image.Interface as I
+import Graphics.Image.Interface.Vector.Generic
+
+
+
+-- | Storable 'Vector' representation.
+data VS = VS
+
+data S
+
+type instance Repr (V S) = VS.Vector
+
+instance Show S where
+  show _ = "Storable"
+
+instance Show VS where
+  show _ = "VectorStorable"
+
+instance SuperClass VS cs e => BaseArray VS cs e where
+  type SuperClass VS cs e =
+    (ColorSpace cs e, Num (Pixel cs e), VS.Storable (Pixel cs e))
+
+  data Image VS cs e = VSImage !(Image (V S) cs e)
+
+  dims (VSImage img) = dims img
+  {-# INLINE dims #-}
+
+
+
+instance (MArray VS cs e, BaseArray VS cs e) => Array VS cs e where
+
+  type Manifest VS = VS
+
+  makeImage !sh = VSImage . makeImage sh
+  {-# INLINE makeImage #-}
+
+  makeImageWindowed !sh !window f g = VSImage $ makeImageWindowed sh window f g
+  {-# INLINE makeImageWindowed #-}
+  
+  singleton = VSImage . singleton
+  {-# INLINE singleton #-}
+
+  index00 (VSImage img) = index00 img
+  {-# INLINE index00 #-}
+  
+  map f (VSImage img) = VSImage $ I.map f img
+  {-# INLINE map #-}
+
+  imap f (VSImage img) = VSImage $ I.imap f img
+  {-# INLINE imap #-}
+  
+  zipWith f (VSImage img1) (VSImage img2) = VSImage $ I.zipWith f img1 img2
+  {-# INLINE zipWith #-}
+
+  izipWith f (VSImage img1) (VSImage img2) = VSImage $ I.izipWith f img1 img2
+  {-# INLINE izipWith #-}
+
+  traverse (VSImage img) f g = VSImage $ I.traverse img f g
+  {-# INLINE traverse #-}
+
+  traverse2 (VSImage img1) (VSImage img2) f g = VSImage $ I.traverse2 img1 img2 f g
+  {-# INLINE traverse2 #-}
+
+  transpose (VSImage img) = VSImage $ I.transpose img
+  {-# INLINE transpose #-}
+
+  backpermute !sz f (VSImage img) = VSImage $ I.backpermute sz f img
+  {-# INLINE backpermute #-}
+  
+  fromLists = VSImage . I.fromLists
+  {-# INLINE fromLists #-}
+
+  fold f !px0 (VSImage img) = fold f px0 img
+  {-# INLINE fold #-}
+
+  foldIx f !px0 (VSImage img) = foldIx f px0 img
+  {-# INLINE foldIx #-}
+
+  (|*|) (VSImage img1) (VSImage img2) = VSImage (img1 |*| img2)
+  {-# INLINE (|*|) #-}
+
+  eq (VSImage img1) (VSImage img2) = img1 == img2
+  {-# INLINE eq #-}
+
+  compute (VSImage img) = VSImage $! compute img
+  {-# INLINE compute #-}
+
+  toManifest = id
+  {-# INLINE toManifest #-}
+
+
+
+instance BaseArray VS cs e => MArray VS cs e where
+  
+  data MImage s VS cs e = MVSImage (MImage s (V S) cs e)
+                              
+
+  unsafeIndex (VSImage img) = unsafeIndex img
+  {-# INLINE unsafeIndex #-}
+
+  deepSeqImage (VSImage img) = deepSeqImage img
+  {-# INLINE deepSeqImage #-}
+
+  foldl f !px0 (VSImage img) = I.foldl f px0 img
+  {-# INLINE foldl #-}
+
+  foldr f !px0 (VSImage img) = I.foldr f px0 img
+  {-# INLINE foldr #-}
+
+  makeImageM !sh f = VSImage <$> makeImageM sh f
+  {-# INLINE makeImageM #-}
+
+  mapM f (VSImage img) = VSImage <$> I.mapM f img
+  {-# INLINE mapM #-}
+
+  mapM_ f (VSImage img) = I.mapM_ f img
+  {-# INLINE mapM_ #-}
+
+  foldM f !px0 (VSImage img) = I.foldM f px0 img
+  {-# INLINE foldM #-}
+
+  foldM_ f !px0 (VSImage img) = I.foldM_ f px0 img
+  {-# INLINE foldM_ #-}
+
+  mdims (MVSImage mimg) = mdims mimg
+  {-# INLINE mdims #-}
+
+  thaw (VSImage img) = MVSImage <$> I.thaw img
+  {-# INLINE thaw #-}
+
+  freeze (MVSImage img) = VSImage <$> I.freeze img
+  {-# INLINE freeze #-}
+
+  new !ix = MVSImage <$> I.new ix
+  {-# INLINE new #-}
+
+  read (MVSImage img) = I.read img
+  {-# INLINE read #-}
+
+  write (MVSImage img) = I.write img
+  {-# INLINE write #-}
+
+  swap (MVSImage img) = I.swap img
+  {-# INLINE swap #-}
+
+
+
+-- | Convert an image to a flattened Storable 'VS.Vector'. It is a __O(1)__ opeartion.
+--
+-- >>> toStorableVector $ makeImage (3, 2) (\(i, j) -> PixelY $ fromIntegral (i+j))
+-- fromList [<Luma:(0.0)>,<Luma:(1.0)>,<Luma:(1.0)>,<Luma:(2.0)>,<Luma:(2.0)>,<Luma:(3.0)>]
+--
+toStorableVector :: Array VS cs e => Image VS cs e -> VS.Vector (Pixel cs e)
+toStorableVector (VSImage img) = toVector img
+{-# INLINE toStorableVector #-}
+
+
+-- | Construct a two dimensional image with @m@ rows and @n@ columns from a flat
+-- Storable 'VS.Vector' of length @k@. It is a __O(1)__ opeartion. Make sure that @m * n = k@.
+--
+-- >>> fromStorableVector (200, 300) $ generate 60000 (\i -> PixelY $ fromIntegral i / 60000)
+-- <Image VectorStorable Luma: 200x300>
+--
+-- <<images/grad_fromVector.png>>
+-- 
+fromStorableVector :: Array VS cs e => (Int, Int) -> VS.Vector (Pixel cs e) -> Image VS cs e
+fromStorableVector !sz !v = VSImage $ fromVector sz v
+{-# INLINE fromStorableVector #-}
diff --git a/src/Graphics/Image/Interface/Vector/Unboxed.hs b/src/Graphics/Image/Interface/Vector/Unboxed.hs
--- a/src/Graphics/Image/Interface/Vector/Unboxed.hs
+++ b/src/Graphics/Image/Interface/Vector/Unboxed.hs
@@ -5,278 +5,192 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE ViewPatterns #-}
 -- |
 -- Module      : Graphics.Image.Interface.Vector.Unboxed
--- Copyright   : (c) Alexey Kuleshevich 2016
+-- Copyright   : (c) Alexey Kuleshevich 2017
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
 -- Portability : non-portable
 --
 module Graphics.Image.Interface.Vector.Unboxed (
-  VU(..), Image(..), fromUnboxedVector, toUnboxedVector, fromIx, toIx, checkDims
+  U, VU(..), VU.Unbox, Image(..), fromUnboxedVector, toUnboxedVector, fromIx, toIx, checkDims
   ) where
 
 import Prelude hiding (map, zipWith)
-import qualified Prelude as P (map)
-import Control.DeepSeq (deepseq)
-import Control.Monad (void)
 #if !MIN_VERSION_base(4,8,0)
 import Data.Functor
 #endif
-import Data.Typeable (Typeable)
-import Data.Vector.Unboxed (Vector, Unbox)
-import qualified Data.Vector.Unboxed as V
-import qualified Data.Vector.Unboxed.Mutable as MV
-import Graphics.Image.Interface
+import qualified Data.Vector.Unboxed as VU
+import Graphics.Image.Interface as I
+import Graphics.Image.Interface.Vector.Generic
 import Graphics.Image.Interface.Vector.Unboxing()
 
 
+
 -- | Unboxed 'Vector' representation.
 data VU = VU
 
+data U
 
+type instance Repr (V U) = VU.Vector
+
+instance Show U where
+  show _ = "Unboxed"
+
 instance Show VU where
   show _ = "VectorUnboxed"
 
-
-instance Elt VU cs e => BaseArray VU cs e where
-  type Elt VU cs e = (ColorSpace cs, Num e, Unbox e, Typeable e, 
-                      Unbox (PixelElt cs e), Unbox (Pixel cs e))
+instance SuperClass VU cs e => BaseArray VU cs e where
+  type SuperClass VU cs e =
+    (ColorSpace cs e, Num (Pixel cs e), VU.Unbox (Components cs e))
 
-  data Image VU cs e = VScalar !(Pixel cs e)
-                     | VUImage !Int !Int !(Vector (Pixel cs e))
+  data Image VU cs e = VUImage !(Image (V U) cs e)
 
-  dims (VUImage m n _) = (m, n)
-  dims (VScalar _)     = (1, 1)
+  dims (VUImage img) = dims img
   {-# INLINE dims #-}
 
 
-instance BaseArray VU cs e => Array VU cs e where
 
+instance (MArray VU cs e, BaseArray VU cs e) => Array VU cs e where
+
   type Manifest VU = VU
 
-  makeImage !(checkDims "VU.makeImage" -> (m, n)) !f =
-    VUImage m n $ V.generate (m * n) (f . toIx n)
+  makeImage !sh = VUImage . makeImage sh
   {-# INLINE makeImage #-}
 
-  singleton = VScalar
+  makeImageWindowed !sh !window f g = VUImage $ makeImageWindowed sh window f g
+  {-# INLINE makeImageWindowed #-}
+  
+  singleton = VUImage . singleton
   {-# INLINE singleton #-}
 
-  index00 (VScalar px) = px
-  index00 (VUImage _ _ v) = v V.! 0
+  index00 (VUImage img) = index00 img
   {-# INLINE index00 #-}
   
-  map !f (VScalar px)    = VScalar (f px)
-  map !f (VUImage m n v) = VUImage m n (V.map f v)
+  map f (VUImage img) = VUImage $ I.map f img
   {-# INLINE map #-}
 
-  imap !f (VScalar px)    = VScalar (f (0, 0) px)
-  imap !f (VUImage m n v) = VUImage m n (V.imap (\ !k !px -> f (toIx n k) px) v)
+  imap f (VUImage img) = VUImage $ I.imap f img
   {-# INLINE imap #-}
   
-  zipWith !f (VScalar px1) (VScalar px2)    = VScalar (f px1 px2)
-  zipWith !f (VScalar px1) (VUImage m n v2) = VUImage m n (V.map (f px1) v2)
-  zipWith !f (VUImage m n v1) (VScalar px2) = VUImage m n (V.map (`f` px2) v1)
-  zipWith !f img1@(VUImage m1 n1 v1) img2@(VUImage m2 n2 v2) =
-    if m1 /= m2 || n1 /= n2
-    then error ("zipWith: Images must be of the same dimensions, received: "++
-                show img1++" and "++show img2++".")
-    else VUImage m1 n1 (V.zipWith f v1 v2)
+  zipWith f (VUImage img1) (VUImage img2) = VUImage $ I.zipWith f img1 img2
   {-# INLINE zipWith #-}
 
-  izipWith !f (VScalar px1) (VScalar px2)    = VScalar (f (0, 0) px1 px2)
-  izipWith !f (VScalar px1) (VUImage m n v2) =
-    VUImage m n (V.imap (\ !k !px2 -> f (toIx n k) px1 px2) v2)
-  izipWith !f (VUImage m n v1) (VScalar px2) =
-    VUImage m n (V.imap (\ !k !px1 -> f (toIx n k) px1 px2) v1)
-  izipWith !f img1@(VUImage m1 n1 v1) img2@(VUImage m2 n2 v2) =
-    if m1 /= m2 || n1 /= n2
-    then error ("izipWith: Images must be of the same dimensions, received: "++
-                show img1++" and "++show img2++".")
-    else VUImage m1 n1 (V.izipWith (\ !k !px1 !px2 -> f (toIx n1 k) px1 px2) v1 v2)
+  izipWith f (VUImage img1) (VUImage img2) = VUImage $ I.izipWith f img1 img2
   {-# INLINE izipWith #-}
 
-  traverse !img !getNewDims !getNewPx = makeImage (getNewDims (dims img)) (getNewPx (index img))
+  traverse (VUImage img) f g = VUImage $ I.traverse img f g
   {-# INLINE traverse #-}
 
-  traverse2 !img1 !img2 !getNewDims !getNewPx =
-    makeImage (getNewDims (dims img1) (dims img2)) (getNewPx (index img1) (index img2))
+  traverse2 (VUImage img1) (VUImage img2) f g = VUImage $ I.traverse2 img1 img2 f g
   {-# INLINE traverse2 #-}
 
-  transpose !img@(dims -> (m, n)) = makeImage (n, m) getPx where
-    getPx !(i, j) = index img (j, i)
-    {-# INLINE getPx #-}
+  transpose (VUImage img) = VUImage $ I.transpose img
   {-# INLINE transpose #-}
 
-  backpermute !(checkDims "VU.backpermute" -> (m, n)) !f (VUImage _ n' v) =
-    VUImage m n $ V.backpermute v $ V.generate (m*n) (fromIx n' . f . toIx n)
-  backpermute !sz _ (VScalar px) = makeImage sz (const px)
+  backpermute !sz f (VUImage img) = VUImage $ I.backpermute sz f img
   {-# INLINE backpermute #-}
   
-  fromLists !ls = if isSquare
-                  then VUImage m n . V.fromList . concat $ ls
-                  else error "fromLists: Inner lists are of different lengths."
-    where
-      !(m, n) = (length ls, length $ head ls)
-      !isSquare = (n > 0) && all (==n) (P.map length ls)
+  fromLists = VUImage . I.fromLists
   {-# INLINE fromLists #-}
 
-  fold !f !px0 (VUImage _ _ v) = V.foldl' f px0 v
-  fold !f !px0 (VScalar px)    = f px0 px
+  fold f !px0 (VUImage img) = fold f px0 img
   {-# INLINE fold #-}
 
-  (|*|) img1@(VUImage m1 n1 v1) !img2@VUImage {} =
-    if n1 /= m2 
-    then error ("Inner dimensions of multiplying images must be the same, but received: "++
-                show img1 ++" X "++ show img2)
-    else
-      makeImage (m1, n2) getPx where
-        VUImage n2 m2 v2 = transpose img2
-        getPx !(i, j) = V.sum $ V.zipWith (*) (V.slice (i*n1) n1 v1) (V.slice (j*m2) m2 v2)
-        {-# INLINE getPx #-}
-  (|*|) (VScalar px1) (VScalar px2) = VScalar (px1 * px2)
-  (|*|) _ _ = error "Scalar Images cannot be multiplied."
+  foldIx f !px0 (VUImage img) = foldIx f px0 img
+  {-# INLINE foldIx #-}
+
+  (|*|) (VUImage img1) (VUImage img2) = VUImage (img1 |*| img2)
   {-# INLINE (|*|) #-}
 
-  eq (VUImage m1 n1 v1) (VUImage m2 n2 v2) =
-    m1 == m2 && n1 == n2 && V.all id (V.zipWith (==) v1 v2)
-  eq (VScalar px1)           (VScalar px2) = px1 == px2
-  eq (VUImage 1 1 v1) (VScalar px2) = v1 V.! 0 == px2
-  eq (VScalar px1) (VUImage 1 1 v2) = v2 V.! 0 == px1
-  eq _ _ = False
+  eq (VUImage img1) (VUImage img2) = img1 == img2
   {-# INLINE eq #-}
 
-  compute (VUImage m n v) = m `seq` n `seq` v `deepseq` (VUImage m n v)
-  compute (VScalar px)    = px `seq` (VScalar px)
+  compute (VUImage img) = VUImage $! compute img
   {-# INLINE compute #-}
 
   toManifest = id
   {-# INLINE toManifest #-}
 
 
-instance Array VU cs e => MArray VU cs e where
+instance BaseArray VU cs e => MArray VU cs e where
   
-  data MImage st VU cs e = MVImage !Int !Int (MV.MVector st (Pixel cs e))
-                         | MVScalar (MV.MVector st (Pixel cs e))
-
+  data MImage s VU cs e = MVUImage (MImage s (V U) cs e)
+                              
 
-  unsafeIndex (VUImage _ n v) !ix = V.unsafeIndex v (fromIx n ix)
-  unsafeIndex (VScalar px)      _ = px
+  unsafeIndex (VUImage img) = unsafeIndex img
   {-# INLINE unsafeIndex #-}
 
-  deepSeqImage (VUImage m n v) = m `seq` n `seq` deepseq v
-  deepSeqImage (VScalar px)    = seq px
+  deepSeqImage (VUImage img) = deepSeqImage img
   {-# INLINE deepSeqImage #-}
 
-  foldl !f !a (VUImage _ _ v) = V.foldl' f a v
-  foldl !f !a (VScalar px)    = f a px
+  foldl f !px0 (VUImage img) = I.foldl f px0 img
   {-# INLINE foldl #-}
 
-  foldr !f !a (VUImage _ _ v) = V.foldr' f a v
-  foldr !f !a (VScalar px)    = f px a
+  foldr f !px0 (VUImage img) = I.foldr f px0 img
   {-# INLINE foldr #-}
 
-  makeImageM !(checkDims "VU.makeImageM" -> (m, n)) !f =
-    VUImage m n <$> V.generateM (m * n) (f . toIx n)
+  makeImageM !sh f = VUImage <$> makeImageM sh f
   {-# INLINE makeImageM #-}
 
-  mapM !f (VUImage m n v) = VUImage m n <$> V.mapM f v
-  mapM !f (VScalar px)    = VScalar <$> f px
+  mapM f (VUImage img) = VUImage <$> I.mapM f img
   {-# INLINE mapM #-}
 
-  mapM_ !f (VUImage _ _ v) = V.mapM_ f v
-  mapM_ !f (VScalar px)    = void $ f px
+  mapM_ f (VUImage img) = I.mapM_ f img
   {-# INLINE mapM_ #-}
 
-  foldM !f !a (VUImage _ _ v) = V.foldM' f a v
-  foldM !f !a (VScalar px)    = f a px
+  foldM f !px0 (VUImage img) = I.foldM f px0 img
   {-# INLINE foldM #-}
 
-  foldM_ !f !a (VUImage _ _ v) = V.foldM'_ f a v
-  foldM_ !f !a (VScalar px)    = void $ f a px
+  foldM_ f !px0 (VUImage img) = I.foldM_ f px0 img
   {-# INLINE foldM_ #-}
 
-
-  mdims (MVImage m n _) = (m, n)
-  mdims (MVScalar _)    = (1, 1)
+  mdims (MVUImage mimg) = mdims mimg
   {-# INLINE mdims #-}
 
-  thaw (VUImage m n v) = MVImage m n <$> V.thaw v
-  thaw (VScalar px)    = MVScalar <$> V.thaw (V.singleton px)
+  thaw (VUImage img) = MVUImage <$> I.thaw img
   {-# INLINE thaw #-}
 
-  freeze (MVImage m n mv) = VUImage m n <$> V.freeze mv
-  freeze (MVScalar mv)    = VScalar . (V.! 0) <$> V.freeze mv
+  freeze (MVUImage img) = VUImage <$> I.freeze img
   {-# INLINE freeze #-}
 
-  new (m, n) = MVImage m n <$> MV.new (m*n)
+  new !ix = MVUImage <$> I.new ix
   {-# INLINE new #-}
 
-  read (MVImage _ n mv) ix = MV.read mv (fromIx n ix)
-  read (MVScalar mv)    _  = MV.read mv 0
+  read (MVUImage img) = I.read img
   {-# INLINE read #-}
 
-  write (MVImage _ n mv) ix = MV.write mv (fromIx n ix)
-  write (MVScalar mv)    _  = MV.write mv 0
+  write (MVUImage img) = I.write img
   {-# INLINE write #-}
 
-  swap (MVImage _ n mv) ix1 ix2 = MV.swap mv (fromIx n ix1) (fromIx n ix2)
-  swap _                _   _   = return ()
+  swap (MVUImage img) = I.swap img
   {-# INLINE swap #-}
 
 
--- | Convert an image to a flattened Unboxed 'Vector'. It is a __O(1)__ opeartion.
+
+-- | Convert an image to a flattened Unboxed 'VU.Vector'. It is a __O(1)__ opeartion.
 --
 -- >>> toUnboxedVector $ makeImage (3, 2) (\(i, j) -> PixelY $ fromIntegral (i+j))
 -- fromList [<Luma:(0.0)>,<Luma:(1.0)>,<Luma:(1.0)>,<Luma:(2.0)>,<Luma:(2.0)>,<Luma:(3.0)>]
 --
-toUnboxedVector :: Array VU cs e => Image VU cs e -> Vector (Pixel cs e)
-toUnboxedVector (VUImage _ _ v) = v
-toUnboxedVector (VScalar px) = V.singleton px
+toUnboxedVector :: Array VU cs e => Image VU cs e -> VU.Vector (Pixel cs e)
+toUnboxedVector (VUImage img) = toVector img
 {-# INLINE toUnboxedVector #-}
 
 
 -- | Construct a two dimensional image with @m@ rows and @n@ columns from a flat
--- Unboxed 'Vector' of length @k@. It is a __O(1)__ opeartion. Make sure that @m * n = k@.
+-- Unboxed 'VU.Vector' of length @k@. It is a __O(1)__ opeartion. Make sure that @m * n = k@.
 --
 -- >>> fromUnboxedVector (200, 300) $ generate 60000 (\i -> PixelY $ fromIntegral i / 60000)
 -- <Image VectorUnboxed Luma: 200x300>
 --
 -- <<images/grad_fromVector.png>>
 -- 
-fromUnboxedVector :: Array VU cs e => (Int, Int) -> Vector (Pixel cs e) -> Image VU cs e
-fromUnboxedVector !(m, n) !v
-  | m * n == V.length v = VUImage m n v
-  | otherwise = error "fromUnboxedVector: m * n doesn't equal the length of a Vector."
+fromUnboxedVector :: Array VU cs e => (Int, Int) -> VU.Vector (Pixel cs e) -> Image VU cs e
+fromUnboxedVector !sz !v = VUImage $ fromVector sz v
 {-# INLINE fromUnboxedVector #-}
-
-
--- | 2D to a flat vector index conversion.
---
--- __Note__: There is an implicit assumption that @j < n@
-fromIx :: Int -- ^ @n@ columns
-       -> (Int, Int) -- ^ @(i, j)@ row, column index
-       -> Int -- ^ Flat vector index
-fromIx !n !(i, j) = n * i + j
-{-# INLINE fromIx #-}
-
-
--- | Flat vector to 2D index conversion.
-toIx :: Int -- ^ @n@ columns
-     -> Int -- ^ Flat vector index
-     -> (Int, Int) -- ^ @(i, j)@ row, column index
-toIx !n !k = divMod k n
-{-# INLINE toIx #-}
-
-
-checkDims :: String -> (Int, Int) -> (Int, Int)
-checkDims err !ds@(m, n)
-  | m <= 0 || n <= 0 = 
-    error $
-    show err ++ ": Image dimensions are expected to be non-negative: " ++ show ds
-  | otherwise = ds
-{-# INLINE checkDims #-}
diff --git a/src/Graphics/Image/Interface/Vector/Unboxing.hs b/src/Graphics/Image/Interface/Vector/Unboxing.hs
--- a/src/Graphics/Image/Interface/Vector/Unboxing.hs
+++ b/src/Graphics/Image/Interface/Vector/Unboxing.hs
@@ -79,11 +79,11 @@
 
 
 -- | Unboxing of a `Pixel`.
-instance (ColorSpace cs, U.Unbox (PixelElt cs e)) => U.Unbox (Pixel cs e)
+instance (ColorSpace cs e, U.Unbox (Components cs e)) => U.Unbox (Pixel cs e)
 
-newtype instance U.MVector s (Pixel cs e) = MV_Pixel (U.MVector s (PixelElt cs e))
+newtype instance U.MVector s (Pixel cs e) = MV_Pixel (U.MVector s (Components cs e))
 
-instance (ColorSpace cs, U.Unbox (PixelElt cs e)) => M.MVector U.MVector (Pixel cs e) where
+instance (ColorSpace cs e, U.Unbox (Components cs e)) => M.MVector U.MVector (Pixel cs e) where
   basicLength (MV_Pixel mvec) = M.basicLength mvec
   {-# INLINE basicLength #-}
   basicUnsafeSlice idx len (MV_Pixel mvec) = MV_Pixel (M.basicUnsafeSlice idx len mvec)
@@ -92,15 +92,15 @@
   {-# INLINE basicOverlaps #-}
   basicUnsafeNew len = MV_Pixel `liftM` M.basicUnsafeNew len
   {-# INLINE basicUnsafeNew #-}
-  basicUnsafeReplicate len val = MV_Pixel `liftM` M.basicUnsafeReplicate len (toElt val)
+  basicUnsafeReplicate len val = MV_Pixel `liftM` M.basicUnsafeReplicate len (toComponents val)
   {-# INLINE basicUnsafeReplicate #-}
-  basicUnsafeRead (MV_Pixel mvec) idx = fromElt `liftM` M.basicUnsafeRead mvec idx
+  basicUnsafeRead (MV_Pixel mvec) idx = fromComponents `liftM` M.basicUnsafeRead mvec idx
   {-# INLINE basicUnsafeRead #-}
-  basicUnsafeWrite (MV_Pixel mvec) idx val = M.basicUnsafeWrite mvec idx (toElt val)
+  basicUnsafeWrite (MV_Pixel mvec) idx val = M.basicUnsafeWrite mvec idx (toComponents val)
   {-# INLINE basicUnsafeWrite #-}
   basicClear (MV_Pixel mvec) = M.basicClear mvec
   {-# INLINE basicClear #-}
-  basicSet (MV_Pixel mvec) val = M.basicSet mvec (toElt val)
+  basicSet (MV_Pixel mvec) val = M.basicSet mvec (toComponents val)
   {-# INLINE basicSet #-}
   basicUnsafeCopy (MV_Pixel mvec) (MV_Pixel mvec') = M.basicUnsafeCopy mvec mvec'
   {-# INLINE basicUnsafeCopy #-}
@@ -114,9 +114,9 @@
 #endif
 
 
-newtype instance U.Vector (Pixel cs e) = V_Pixel (U.Vector (PixelElt cs e))
+newtype instance U.Vector (Pixel cs e) = V_Pixel (U.Vector (Components cs e))
 
-instance (ColorSpace cs, U.Unbox (PixelElt cs e)) => V.Vector U.Vector (Pixel cs e) where
+instance (ColorSpace cs e, U.Unbox (Components cs e)) => V.Vector U.Vector (Pixel cs e) where
   basicUnsafeFreeze (MV_Pixel mvec) = V_Pixel `liftM` V.basicUnsafeFreeze mvec
   {-# INLINE basicUnsafeFreeze #-}
   basicUnsafeThaw (V_Pixel vec) = MV_Pixel `liftM` V.basicUnsafeThaw vec
@@ -125,9 +125,9 @@
   {-# INLINE basicLength #-}
   basicUnsafeSlice idx len (V_Pixel vec) = V_Pixel (V.basicUnsafeSlice idx len vec)
   {-# INLINE basicUnsafeSlice #-}
-  basicUnsafeIndexM (V_Pixel vec) idx = fromElt `liftM` V.basicUnsafeIndexM vec idx
+  basicUnsafeIndexM (V_Pixel vec) idx = fromComponents `liftM` V.basicUnsafeIndexM vec idx
   {-# INLINE basicUnsafeIndexM #-}
   basicUnsafeCopy (MV_Pixel mvec) (V_Pixel vec) = V.basicUnsafeCopy mvec vec
   {-# INLINE basicUnsafeCopy #-}
-  elemseq (V_Pixel vec) val = V.elemseq vec (toElt val)
+  elemseq (V_Pixel vec) val = V.elemseq vec (toComponents val)
   {-# INLINE elemseq #-}
diff --git a/src/Graphics/Image/Processing.hs b/src/Graphics/Image/Processing.hs
--- a/src/Graphics/Image/Processing.hs
+++ b/src/Graphics/Image/Processing.hs
@@ -39,7 +39,7 @@
 --
 -- <<images/frog.jpg>> <<images/frog_eye_grid.png>>
 --
-pixelGrid :: (Array arr cs e, Elevator e) =>
+pixelGrid :: Array arr cs e =>
              Word8          -- ^ Magnification factor.
           -> Image arr cs e -- ^ Source image.
           -> Image arr cs e
@@ -47,7 +47,7 @@
   getNewDims !(m, n) = (1 + m*k, 1 + n*k)
   {-# INLINE getNewDims #-}
   getNewPx !getPx !(i, j) = if i `mod` k == 0 || j `mod` k == 0
-                            then fromDouble $ fromChannel 0.5
+                            then broadcastC $ fromDouble 0.5
                             else getPx ((i - 1) `div` k, (j - 1) `div` k)
   {-# INLINE getNewPx #-}
 {-# INLINE pixelGrid #-}
diff --git a/src/Graphics/Image/Processing/Binary.hs b/src/Graphics/Image/Processing/Binary.hs
--- a/src/Graphics/Image/Processing/Binary.hs
+++ b/src/Graphics/Image/Processing/Binary.hs
@@ -43,6 +43,7 @@
 infixr 2  .||.
 
 
+
 -- | 'Thresholding' contains a convenient set of functions for binary image
 -- construction, which is done by comparing either a single pixel with every
 -- pixel in an image or two same size images pointwise. For example:
@@ -166,7 +167,8 @@
 --
 -- <<images/yield.jpg>> <<images/yield_bin.png>>
 --
-thresholdWith :: (Array arr cs e, Array arr Binary Bit) =>
+thresholdWith :: (Applicative (Pixel cs), Foldable (Pixel cs),
+                  Array arr cs e, Array arr Binary Bit) =>
                  Pixel cs (e -> Bool)
                  -- ^ Pixel containing a thresholding function per channel.
               -> Image arr cs e -- ^ Source image.
@@ -177,7 +179,8 @@
 
 -- | Compare two images with an applicative pixel. Works just like
 -- 'thresholdWith', but on two images.
-compareWith :: (Array arr cs e1, Array arr cs e2, Array arr Binary Bit) =>
+compareWith :: (Applicative (Pixel cs), Foldable (Pixel cs),
+                Array arr cs e1, Array arr cs e2, Array arr Binary Bit) =>
                Pixel cs (e1 -> e2 -> Bool)
                -- ^ Pixel containing a comparing function per channel.
             -> Image arr cs e1 -- ^ First image.
@@ -188,8 +191,9 @@
 
 
 {- $morphology In order to demonstrate how morphological operations work, a
-/binary source image/ = __B__ constructed here together with a /structuring element/ =
-__S__ will be used in examples that follow.
+/binary source image/ = __B__ constructed here together with a /structuring element/
+= __S__ will be used in examples that follow. Origin of the structuring
+element is always at it's center, eg. @(1,1)@ for the one below.
 
 @
 figure :: Image VU Binary Bit
@@ -211,7 +215,7 @@
                     [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0],
                     [0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0]]
 struct :: Image VU Binary Bit
-struct = fromLists [[0,1],[1,1],[0,1]]
+struct = fromLists [[0,1,0],[1,1,0],[0,1,0]]
 @
 -}
 
diff --git a/src/Graphics/Image/Processing/Complex.hs b/src/Graphics/Image/Processing/Complex.hs
--- a/src/Graphics/Image/Processing/Complex.hs
+++ b/src/Graphics/Image/Processing/Complex.hs
@@ -10,11 +10,11 @@
 --
 module Graphics.Image.Processing.Complex (
   -- * Rectangular form
-  (!+!), realPart', imagPart',
+  (!+!), realPartI, imagPartI,
   -- * Polar form
-  mkPolar', cis', polar', magnitude', phase',
+  mkPolarI, cisI, polarI, magnitudeI, phaseI,
   -- * Conjugate
-  conjugate',
+  conjugateI,
   -- * Processing
   makeFilter, applyFilter,
   -- ** Fourier Transform
@@ -37,61 +37,61 @@
 -- >>> frog !+! frog
 -- <Image VectorUnboxed RGB (Complex Double): 200x320>
 --
-(!+!) :: (Array arr cs e, Array arr cs (Complex e)) =>
+(!+!) :: (Applicative (Pixel cs), Array arr cs e, Array arr cs (Complex e)) =>
          Image arr cs e -> Image arr cs e -> Image arr cs (Complex e)
 (!+!) = zipWith (+:)
 {-# INLINE (!+!) #-}
 
 -- | Extracts the real part of a complex image.
-realPart' :: (Array arr cs e, Array arr cs (Complex e), RealFloat e) =>
+realPartI :: (Applicative (Pixel cs), Array arr cs e, Array arr cs (Complex e), RealFloat e) =>
              Image arr cs (Complex e) -> Image arr cs e
-realPart' = map realPart
-{-# INLINE realPart' #-}
+realPartI = map realPart
+{-# INLINE realPartI #-}
 
 -- | Extracts the imaginary part of a complex image.
-imagPart' :: (Array arr cs e, Array arr cs (Complex e), RealFloat e) =>
+imagPartI :: (Applicative (Pixel cs), Array arr cs e, Array arr cs (Complex e), RealFloat e) =>
              Image arr cs (Complex e) -> Image arr cs e
-imagPart' = map imagPart
-{-# INLINE imagPart' #-}
+imagPartI = map imagPart
+{-# INLINE imagPartI #-}
 
 -- | Form a complex image from polar components of magnitude and phase.
-mkPolar' :: (Array arr cs e, Array arr cs (Complex e), RealFloat e) =>
+mkPolarI :: (Applicative (Pixel cs), Array arr cs e, Array arr cs (Complex e), RealFloat e) =>
             Image arr cs e -> Image arr cs e -> Image arr cs (Complex e)
-mkPolar' = zipWith mkPolar
-{-# INLINE mkPolar' #-}
+mkPolarI = zipWith mkPolar
+{-# INLINE mkPolarI #-}
 
--- | @'cis'' t@ is a complex image with magnitude 1 and phase t (modulo @2*'pi'@).
-cis' :: (Array arr cs e, Array arr cs (Complex e), RealFloat e) =>
+-- | @'cisI' t@ is a complex image with magnitude 1 and phase t (modulo @2*'pi'@).
+cisI :: (Applicative (Pixel cs), Array arr cs e, Array arr cs (Complex e), RealFloat e) =>
         Image arr cs e -> Image arr cs (Complex e)
-cis' = map cis
-{-# INLINE cis' #-}
+cisI = map cis
+{-# INLINE cisI #-}
 
 -- | The function @'polar''@ takes a complex image and returns a (magnitude, phase)
 -- pair of images in canonical form: the magnitude is nonnegative, and the phase
 -- in the range @(-'pi', 'pi']@; if the magnitude is zero, then so is the phase.
-polar' :: (Array arr cs e, Array arr cs (Complex e), RealFloat e) =>
+polarI :: (Applicative (Pixel cs), Array arr cs e, Array arr cs (Complex e), RealFloat e) =>
           Image arr cs (Complex e) -> (Image arr cs e, Image arr cs e)
-polar' !zImg = (magnitude' zImg, phase' zImg)
-{-# INLINE polar' #-}
+polarI !zImg = (magnitudeI zImg, phaseI zImg)
+{-# INLINE polarI #-}
 
 -- | The nonnegative magnitude of a complex image.
-magnitude' :: (Array arr cs e, Array arr cs (Complex e), RealFloat e) =>
+magnitudeI :: (Applicative (Pixel cs), Array arr cs e, Array arr cs (Complex e), RealFloat e) =>
               Image arr cs (Complex e) -> Image arr cs e
-magnitude' = map magnitude
-{-# INLINE magnitude' #-}
+magnitudeI = map magnitude
+{-# INLINE magnitudeI #-}
 
 -- | The phase of a complex image, in the range @(-'pi', 'pi']@. If the
 -- magnitude is zero, then so is the phase.
-phase' :: (Array arr cs e, Array arr cs (Complex e), RealFloat e) =>
+phaseI :: (Applicative (Pixel cs), Array arr cs e, Array arr cs (Complex e), RealFloat e) =>
           Image arr cs (Complex e) -> Image arr cs e
-phase' = map phase
-{-# INLINE phase' #-}
+phaseI = map phase
+{-# INLINE phaseI #-}
 
 -- | The conjugate of a complex image.
-conjugate' :: (Array arr cs e, Array arr cs (Complex e), RealFloat e) =>
+conjugateI :: (Applicative (Pixel cs), Array arr cs (Complex e), RealFloat e) =>
               Image arr cs (Complex e) -> Image arr cs (Complex e)
-conjugate' = map conjugate
-{-# INLINE conjugate' #-}
+conjugateI = map conjugate
+{-# INLINE conjugateI #-}
 
 
 -- | Make a filter by using a function that works around a regular @(x, y)@
@@ -111,29 +111,11 @@
 
 
 -- | Apply a filter to an image created by 'makeFilter'.
-applyFilter :: (Array arr cs e, Array arr cs (Complex e), RealFloat e) =>
+applyFilter :: (Applicative (Pixel cs), Array arr cs e, Array arr cs (Complex e),
+                Fractional (Pixel cs (Complex e)), Floating (Pixel cs e), RealFloat e) =>
                Image arr cs e -- ^ Source image.
             -> Image arr cs e -- ^ Filter.
             -> Image arr cs e
-applyFilter img filt = realPart' . ifft $ (fft (img !+! 0) * (filt !+! filt))
+applyFilter img filt = realPartI . ifft $ (fft (img !+! 0) * (filt !+! filt))
 {-# INLINE applyFilter #-}
 
-{-
-gaussianBandpass :: (ManifestArray arr cs e, RealFloat e) =>
-                    Int -> e -> e -> Image arr cs e
-gaussianBandpass n center variance = makeFilter (n, n) bandpass where
-  gaussian (x, y) = fromChannel $ exp (-(x^(2 :: Int) + y^(2 :: Int)) / (2*variance))
-  bandpass (fromIntegral -> y, fromIntegral -> x) = gaussian (x', y')
-    where (x' :+ y') = C.mkPolar (mag - center) ph
-          (mag, ph) = C.polar (x :+ y)
--}          
-
-{-
-idealBandpass :: (ManifestArray arr cs e, RealFloat e) =>
-                 Int -> e -> e -> Image arr cs e
-idealBandpass n width center = makeFilter (n, n) bandpass where
-  bandpass (fromIntegral -> r, fromIntegral -> c)
-    | center <= mag && mag <= (width + center) = 1
-    | otherwise = 0
-    where mag = C.magnitude (r :+ c)
--}
diff --git a/src/Graphics/Image/Processing/Complex/Fourier.hs b/src/Graphics/Image/Processing/Complex/Fourier.hs
--- a/src/Graphics/Image/Processing/Complex/Fourier.hs
+++ b/src/Graphics/Image/Processing/Complex/Fourier.hs
@@ -30,7 +30,9 @@
           | Inverse
 
 -- | Fast Fourier Transform
-fft :: (Array arr cs (Complex e), RealFloat e) =>
+fft :: (Applicative (Pixel cs),
+        Array arr cs (Complex e),
+        Fractional (Pixel cs (Complex e)), Floating (Pixel cs e), RealFloat e) =>
        Image arr cs (Complex e)
     -> Image arr cs (Complex e)
 fft = fft2d Forward
@@ -38,7 +40,9 @@
 
 
 -- | Inverse Fast Fourier Transform
-ifft :: (Array arr cs (Complex e), RealFloat e) =>
+ifft :: (Applicative (Pixel cs),
+         Array arr cs (Complex e),
+         Fractional (Pixel cs (Complex e)), Floating (Pixel cs e), RealFloat e) =>
         Image arr cs (Complex e)
      -> Image arr cs (Complex e)
 ifft = fft2d Inverse
@@ -58,7 +62,9 @@
 
 
 -- | Compute the DFT of a matrix. Array dimensions must be powers of two else `error`.
-fft2d :: (Array arr cs (Complex e), Num e, RealFloat e) =>
+fft2d :: (Applicative (Pixel cs),
+          Array arr cs (Complex e),
+          Fractional (Pixel cs (Complex e)), Floating (Pixel cs e), RealFloat e) =>
          Mode
       -> Image arr cs (Complex e)
       -> Image arr cs (Complex e)
@@ -77,7 +83,9 @@
 {-# INLINE fft2d #-}
 
 
-fftGeneral :: (Array arr cs (Complex e), Num e, RealFloat e) =>
+fftGeneral :: (Applicative (Pixel cs),
+               Array arr cs (Complex e),
+               Floating (Pixel cs e), RealFloat e) =>
               Pixel cs e
            -> Image arr cs (Complex e)
            -> Image arr cs (Complex e)
@@ -101,7 +109,8 @@
 
 
 -- Compute a twiddle factor.
-twiddle :: (ColorSpace cs, Floating e) =>
+twiddle :: (Applicative (Pixel cs),
+            Floating (Pixel cs e)) =>
            Pixel cs e
         -> Int                  -- index
         -> Int                  -- length
diff --git a/src/Graphics/Image/Processing/Convolution.hs b/src/Graphics/Image/Processing/Convolution.hs
--- a/src/Graphics/Image/Processing/Convolution.hs
+++ b/src/Graphics/Image/Processing/Convolution.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE FlexibleContexts #-}
 -- |
 -- Module      : Graphics.Image.Processing.Convolution
 -- Copyright   : (c) Alexey Kuleshevich 2016
@@ -8,19 +9,19 @@
 -- Portability : non-portable
 --
 module Graphics.Image.Processing.Convolution (
-  convolve, convolveRows, convolveCols,
+  convolve, convolveRows, convolveCols
   ) where
 
-import Prelude hiding (map)
-import qualified Prelude as P (map)
-import Graphics.Image.Interface
+import Prelude as P
+import Graphics.Image.Interface as I
+--import Graphics.Image.Interface.Vector.Sparse
 import Graphics.Image.Processing.Geometric
 
 
 
-convolve'' :: Array arr cs e =>
+convolve' :: Array arr cs e =>
               Border (Pixel cs e) -> Image arr cs e -> Image arr cs e -> Image arr cs e
-convolve'' !border !kernel !img =
+convolve' !border !kernel !img =
   traverse2 (compute kernel) (compute img) (const . const sz) stencil
   where
     !(krnM, krnN)     = dims kernel
@@ -38,10 +39,35 @@
         | otherwise             = let !krnPx = getKrnPx (ki, kj)
                                       !imgPx = getPxB getImgPx (ki + ikrnM, kj + jkrnN)
                                   in integrate ki (kj + 1) (acc + krnPx * imgPx)
-      {-# INLINE integrate #-}
     {-# INLINE stencil #-}
-{-# INLINE convolve'' #-}
+{-# INLINE convolve' #-}
 
+-- convolveSparse :: (Exchangable arr VS, Array arr cs e, Array VS cs e)  =>
+--                    Border (Pixel cs e) -> Image arr cs e -> Image arr cs e -> Image arr cs e
+-- convolveSparse !border !kernel !img =
+--   makeImageWindowed
+--     sz
+--     ((krnM2, krnN2), (m - krnM2, n - krnN2))
+--     (stencil (unsafeIndex imgM))
+--     (stencil (borderIndex border imgM))
+--   where
+--     !imgM = toManifest img
+--     !kernel' = exchange VS $ compute kernel
+--     -- !kernel' = exchange VS kernel -- deadlock?!?!?
+--     !(krnM, krnN) = dims kernel'
+--     !krnM2 = krnM `div` 2
+--     !krnN2 = krnN `div` 2
+--     !sz@(m, n) = dims img
+--     stencil getPx !(i, j) = foldIx integral 0 kernel'
+--       where
+--         integral !acc !(ki, kj) !px = px * (getPx (ki + ikrnM, kj + jkrnN)) + acc
+--         {-# INLINE integral #-}
+--         !ikrnM = i - krnM2
+--         !jkrnN = j - krnN2
+--     {-# INLINE stencil #-}
+-- {-# INLINE convolveSparse #-}
+
+
 -- | Convolution of an image using a kernel. Border resolution technique is required.
 --
 -- Example using <https://en.wikipedia.org/wiki/Sobel_operator Sobel operator>:
@@ -53,12 +79,12 @@
 --
 -- <<images/frogY.jpg>> <<images/frog_sobel.jpg>>
 --
-convolve  :: Array arr cs e =>
-             Border (Pixel cs e)   -- ^ Approach to be used near the borders.
+convolve :: Array arr cs e =>
+             Border (Pixel cs e) -- ^ Approach to be used near the borders.
           -> Image arr cs e -- ^ Kernel image.
           -> Image arr cs e -- ^ Source image.
           -> Image arr cs e
-convolve !out = convolve'' out . rotate180
+convolve !out = convolve' out . rotate180
 {-# INLINE convolve #-}
 
 
diff --git a/src/Graphics/Image/Processing/Geometric.hs b/src/Graphics/Image/Processing/Geometric.hs
--- a/src/Graphics/Image/Processing/Geometric.hs
+++ b/src/Graphics/Image/Processing/Geometric.hs
@@ -51,7 +51,7 @@
     (\ !getPx !(i, j) ->
         if i `mod` fm == 0 && j `mod` fn == 0
           then getPx (i `div` fm, j `div` fn)
-          else fromChannel 0)
+          else 0)
 {-# INLINE upsampleF #-}
 
 
@@ -209,7 +209,7 @@
            -> Image arr cs e -- ^ Source image.
            -> Image arr cs e              
 superimpose !(i0, j0) !imgA !imgB = traverse2 imgB imgA const newPx where
-  (m, n) = dims imgA
+  !(m, n) = dims imgA
   newPx getPxB getPxA (i, j) = let !(i', j') = (i - i0, j - j0) in
     if i' >= 0 && j' >= 0 && i' < m && j' < n then getPxA (i', j') else getPxB (i, j)
 {-# INLINE superimpose #-}
@@ -218,7 +218,7 @@
 
 flipUsing :: Array arr cs e =>
              ((Int, Int) -> (Int, Int) -> (Int, Int)) -> Image arr cs e -> Image arr cs e
-flipUsing getNewIndex !img@(dims -> d) = backpermute d (getNewIndex d) img
+flipUsing getNewIndex !img@(dims -> sz) = backpermute sz (getNewIndex sz) img
 {-# INLINE flipUsing #-}
 
 
@@ -290,7 +290,7 @@
 --
 -- <<images/frog.jpg>> <<images/frog_rotate330.png>>
 --
-rotate :: (Array arr cs e, Elevator e, Interpolation method) =>
+rotate :: (Array arr cs e, Interpolation method) =>
           method -- ^ Interpolation method to be used
        -> Border (Pixel cs e) -- ^ Border handling strategy
        -> Double -- ^ Angle in radians
@@ -323,7 +323,7 @@
 --
 -- <<images/frog_resize.jpg>>
 --
-resize :: (Interpolation method, Array arr cs e, Elevator e) =>
+resize :: (Interpolation method, Array arr cs e) =>
           method -- ^ Interpolation method to be used during scaling.
        -> Border (Pixel cs e) -- ^ Border handling strategy
        -> (Int, Int)     -- ^ Dimensions of a result image.
@@ -343,7 +343,7 @@
 --
 -- @ scale 'Bilinear' 'Edge' (0.5, 2) frog == resize 'Bilinear' 'Edge' (100, 640) frog @
 --
-scale :: (Interpolation method, Array arr cs e, Elevator e) =>
+scale :: (Interpolation method, Array arr cs e) =>
          method -- ^ Interpolation method to be used during scaling.
       -> Border (Pixel cs e) -- ^ Border handling strategy
       -> (Double, Double) -- ^ Positive scaling factors.
diff --git a/src/Graphics/Image/Processing/Interpolation.hs b/src/Graphics/Image/Processing/Interpolation.hs
--- a/src/Graphics/Image/Processing/Interpolation.hs
+++ b/src/Graphics/Image/Processing/Interpolation.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE ViewPatterns #-}
 -- |
@@ -18,7 +19,7 @@
 class Interpolation method where
 
   -- | Construct a new pixel by using information from neighboring pixels.
-  interpolate :: (Elevator e, Num e, ColorSpace cs) =>
+  interpolate :: (Num (Pixel cs e), ColorSpace cs e) =>
                  method -- ^ Interpolation method
               -> Border (Pixel cs e) -- ^ Border resolution strategy
               -> (Int, Int)          -- ^ Image dimensions @m@ rows and @n@ columns.
@@ -39,20 +40,20 @@
 
 instance Interpolation Nearest where
 
-  interpolate Nearest border !sz !getPx !(i, j) =
+  interpolate Nearest border !sz getPx !(i, j) =
     handleBorderIndex border sz getPx (round i, round j)
   {-# INLINE interpolate #-}
 
 
 instance Interpolation Bilinear where
 
-  interpolate Bilinear border !sz !getPx !(i, j) = fi0 + jPx*(fi1-fi0) where
+  interpolate Bilinear border !sz getPx !(i, j) = fi0 + jPx*(fi1-fi0) where
     getPx' = handleBorderIndex border sz getPx
     {-# INLINE getPx' #-}
     !(i0, j0) = (floor i, floor j)
     !(i1, j1) = (i0 + 1, j0 + 1)
-    !iPx = fromDouble $ fromChannel (i - fromIntegral i0)
-    !jPx = fromDouble $ fromChannel (j - fromIntegral j0)
+    !iPx = broadcastC $ fromDouble (i - fromIntegral i0)
+    !jPx = broadcastC $ fromDouble (j - fromIntegral j0)
     !f00 = getPx' (i0, j0)
     !f10 = getPx' (i1, j0)
     !f01 = getPx' (i0, j1) 
diff --git a/src/Graphics/Image/Types.hs b/src/Graphics/Image/Types.hs
--- a/src/Graphics/Image/Types.hs
+++ b/src/Graphics/Image/Types.hs
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 -- |
 -- Module      : Graphics.Image.Types
 -- Copyright   : (c) Alexey Kuleshevich 2016
@@ -11,12 +12,77 @@
   module Graphics.Image.IO.Formats,
   Array, Image, MArray, MImage,
   Exchangable, Border(..),
-  VU(..), RS(..), RP(..),
+  VU(..), VS(..), RSU(..), RPU(..), RSS(..), RPS(..)
   ) where
 
 
 import Graphics.Image.ColorSpace
-import Graphics.Image.Interface
-import Graphics.Image.Interface.Vector (VU(..))
-import Graphics.Image.Interface.Repa (RS(..), RP(..))
+import Graphics.Image.Interface as I
+import Graphics.Image.Interface.Vector (VU(..), VS(..))
+import Graphics.Image.Interface.Repa (RSU(..), RPU(..), RSS(..), RPS(..))
 import Graphics.Image.IO.Formats
+
+
+
+{-# RULES
+"Image VU Y Double ^ 2/Int" forall (img :: Image VU Y Double). img ^ (2 :: Int) = I.map (^ (2 :: Int)) img
+"Image VU Y Double ^ 3/Int" forall (img :: Image VU Y Double). img ^ (3 :: Int) = I.map (^ (3 :: Int)) img
+"Image VU Y Double ^ 4/Int" forall (img :: Image VU Y Double). img ^ (4 :: Int) = I.map (^ (4 :: Int)) img
+"Image VU Y Double ^ 5/Int" forall (img :: Image VU Y Double). img ^ (5 :: Int) = I.map (^ (5 :: Int)) img
+"Image VU Y Double ^ 2/Integer" forall (img :: Image VU Y Double). img ^ (2 :: Integer) = I.map (^ (2 :: Integer)) img
+"Image VU Y Double ^ 3/Integer" forall (img :: Image VU Y Double). img ^ (3 :: Integer) = I.map (^ (3 :: Integer)) img
+"Image VU Y Double ^ 4/Integer" forall (img :: Image VU Y Double). img ^ (4 :: Integer) = I.map (^ (4 :: Integer)) img
+"Image VU Y Double ^ 5/Integer" forall (img :: Image VU Y Double). img ^ (5 :: Integer) = I.map (^ (5 :: Integer)) img
+"Image VU Y Double ^ n" forall (img :: Image VU Y Double) n. img ^ n = I.map (^n) img
+"Image RPU Y Double ^ 2/Int" forall (img :: Image RPU Y Double). img ^ (2 :: Int) = I.map (^ (2 :: Int)) img
+"Image RPU Y Double ^ 3/Int" forall (img :: Image RPU Y Double). img ^ (3 :: Int) = I.map (^ (3 :: Int)) img
+"Image RPU Y Double ^ 4/Int" forall (img :: Image RPU Y Double). img ^ (4 :: Int) = I.map (^ (4 :: Int)) img
+"Image RPU Y Double ^ 5/Int" forall (img :: Image RPU Y Double). img ^ (5 :: Int) = I.map (^ (5 :: Int)) img
+"Image RPU Y Double ^ 2/Integer" forall (img :: Image RPU Y Double). img ^ (2 :: Integer) = I.map (^ (2 :: Integer)) img
+"Image RPU Y Double ^ 3/Integer" forall (img :: Image RPU Y Double). img ^ (3 :: Integer) = I.map (^ (3 :: Integer)) img
+"Image RPU Y Double ^ 4/Integer" forall (img :: Image RPU Y Double). img ^ (4 :: Integer) = I.map (^ (4 :: Integer)) img
+"Image RPU Y Double ^ 5/Integer" forall (img :: Image RPU Y Double). img ^ (5 :: Integer) = I.map (^ (5 :: Integer)) img
+"Image RPU Y Double ^ n" forall (img :: Image RPU Y Double) n. img ^ n = I.map (^n) img
+"Image RSU Y Double ^ 2/Int" forall (img :: Image RSU Y Double). img ^ (2 :: Int) = I.map (^ (2 :: Int)) img
+"Image RSU Y Double ^ 3/Int" forall (img :: Image RSU Y Double). img ^ (3 :: Int) = I.map (^ (3 :: Int)) img
+"Image RSU Y Double ^ 4/Int" forall (img :: Image RSU Y Double). img ^ (4 :: Int) = I.map (^ (4 :: Int)) img
+"Image RSU Y Double ^ 5/Int" forall (img :: Image RSU Y Double). img ^ (5 :: Int) = I.map (^ (5 :: Int)) img
+"Image RSU Y Double ^ 2/Integer" forall (img :: Image RSU Y Double). img ^ (2 :: Integer) = I.map (^ (2 :: Integer)) img
+"Image RSU Y Double ^ 3/Integer" forall (img :: Image RSU Y Double). img ^ (3 :: Integer) = I.map (^ (3 :: Integer)) img
+"Image RSU Y Double ^ 4/Integer" forall (img :: Image RSU Y Double). img ^ (4 :: Integer) = I.map (^ (4 :: Integer)) img
+"Image RSU Y Double ^ 5/Integer" forall (img :: Image RSU Y Double). img ^ (5 :: Integer) = I.map (^ (5 :: Integer)) img
+"Image RSU Y Double ^ n" forall (img :: Image RSU Y Double) n. img ^ n = I.map (^n) img
+"Image VU RGB Double ^ 2/Int" forall (img :: Image VU RGB Double). img ^ (2 :: Int) = I.map (^ (2 :: Int)) img
+"Image VU RGB Double ^ 3/Int" forall (img :: Image VU RGB Double). img ^ (3 :: Int) = I.map (^ (3 :: Int)) img
+"Image VU RGB Double ^ 4/Int" forall (img :: Image VU RGB Double). img ^ (4 :: Int) = I.map (^ (4 :: Int)) img
+"Image VU RGB Double ^ 5/Int" forall (img :: Image VU RGB Double). img ^ (5 :: Int) = I.map (^ (5 :: Int)) img
+"Image VU RGB Double ^ 2/Integer" forall (img :: Image VU RGB Double). img ^ (2 :: Integer) = I.map (^ (2 :: Integer)) img
+"Image VU RGB Double ^ 3/Integer" forall (img :: Image VU RGB Double). img ^ (3 :: Integer) = I.map (^ (3 :: Integer)) img
+"Image VU RGB Double ^ 4/Integer" forall (img :: Image VU RGB Double). img ^ (4 :: Integer) = I.map (^ (4 :: Integer)) img
+"Image VU RGB Double ^ 5/Integer" forall (img :: Image VU RGB Double). img ^ (5 :: Integer) = I.map (^ (5 :: Integer)) img
+"Image VU RGB Double ^ n" forall (img :: Image VU RGB Double) n. img ^ n = I.map (^n) img
+"Image RPU RGB Double ^ 2/Int" forall (img :: Image RPU RGB Double). img ^ (2 :: Int) = I.map (^ (2 :: Int)) img
+"Image RPU RGB Double ^ 3/Int" forall (img :: Image RPU RGB Double). img ^ (3 :: Int) = I.map (^ (3 :: Int)) img
+"Image RPU RGB Double ^ 4/Int" forall (img :: Image RPU RGB Double). img ^ (4 :: Int) = I.map (^ (4 :: Int)) img
+"Image RPU RGB Double ^ 5/Int" forall (img :: Image RPU RGB Double). img ^ (5 :: Int) = I.map (^ (5 :: Int)) img
+"Image RPU RGB Double ^ 2/Integer" forall (img :: Image RPU RGB Double). img ^ (2 :: Integer) = I.map (^ (2 :: Integer)) img
+"Image RPU RGB Double ^ 3/Integer" forall (img :: Image RPU RGB Double). img ^ (3 :: Integer) = I.map (^ (3 :: Integer)) img
+"Image RPU RGB Double ^ 4/Integer" forall (img :: Image RPU RGB Double). img ^ (4 :: Integer) = I.map (^ (4 :: Integer)) img
+"Image RPU RGB Double ^ 5/Integer" forall (img :: Image RPU RGB Double). img ^ (5 :: Integer) = I.map (^ (5 :: Integer)) img
+"Image RPU RGB Double ^ n" forall (img :: Image RPU RGB Double) n. img ^ n = I.map (^n) img
+"Image RSU RGB Double ^ 2/Int" forall (img :: Image RSU RGB Double). img ^ (2 :: Int) = I.map (^ (2 :: Int)) img
+"Image RSU RGB Double ^ 3/Int" forall (img :: Image RSU RGB Double). img ^ (3 :: Int) = I.map (^ (3 :: Int)) img
+"Image RSU RGB Double ^ 4/Int" forall (img :: Image RSU RGB Double). img ^ (4 :: Int) = I.map (^ (4 :: Int)) img
+"Image RSU RGB Double ^ 5/Int" forall (img :: Image RSU RGB Double). img ^ (5 :: Int) = I.map (^ (5 :: Int)) img
+"Image RSU RGB Double ^ 2/Integer" forall (img :: Image RSU RGB Double). img ^ (2 :: Integer) = I.map (^ (2 :: Integer)) img
+"Image RSU RGB Double ^ 3/Integer" forall (img :: Image RSU RGB Double). img ^ (3 :: Integer) = I.map (^ (3 :: Integer)) img
+"Image RSU RGB Double ^ 4/Integer" forall (img :: Image RSU RGB Double). img ^ (4 :: Integer) = I.map (^ (4 :: Integer)) img
+"Image RSU RGB Double ^ 5/Integer" forall (img :: Image RSU RGB Double). img ^ (5 :: Integer) = I.map (^ (5 :: Integer)) img
+"Image RSU RGB Double ^ n" forall (img :: Image RSU RGB Double) n. img ^ n = I.map (^n) img
+ #-}
+
+
+
+--{-# RULES
+--"I.map/id" forall img. I.map id img = img
+-- #-}
diff --git a/tests/Graphics/Image/ColorSpaceSpec.hs b/tests/Graphics/Image/ColorSpaceSpec.hs
--- a/tests/Graphics/Image/ColorSpaceSpec.hs
+++ b/tests/Graphics/Image/ColorSpaceSpec.hs
@@ -30,11 +30,11 @@
     II.mapM (const arbitrary) $ I.makeImage (m, n) (const $ PixelGray (0 :: Double))
   
 
-prop_ToFromElt :: (ColorSpace cs, Eq (Pixel cs e)) =>
-                  Pixel cs e -> Bool
-prop_ToFromElt px = px == fromElt (toElt px)
+prop_ToFromComponents :: (ColorSpace cs e, Eq (Pixel cs e)) =>
+                         Pixel cs e -> Bool
+prop_ToFromComponents px = px == fromComponents (toComponents px)
 
 
 spec :: Spec
 spec = describe "ColorSpace" $ do
-  it "RGBElt" $ property (prop_ToFromElt :: Pixel RGB Int -> Bool)
+  it "RGBComponents" $ property (prop_ToFromComponents :: Pixel RGB Double -> Bool)
diff --git a/tests/Graphics/Image/Interface/VectorSpec.hs b/tests/Graphics/Image/Interface/VectorSpec.hs
--- a/tests/Graphics/Image/Interface/VectorSpec.hs
+++ b/tests/Graphics/Image/Interface/VectorSpec.hs
@@ -4,22 +4,21 @@
 import Test.Hspec
 import Test.QuickCheck
 
-import qualified Graphics.Image as IM
-import qualified Graphics.Image.Interface.Vector as IV
-import Graphics.Image.Types
+import Graphics.Image as I
+import Graphics.Image.Interface.Vector
 
 import Graphics.Image.InterfaceSpec ()
 
 prop_fromToIx :: Positive Int -> (NonNegative Int, NonNegative Int) -> Bool
 prop_fromToIx (Positive n) (NonNegative i, NonNegative j) =
-  (i, j `mod` n) == IV.toIx n (IV.fromIx n (i, j `mod` n))
+  (i, j `mod` n) == toIx n (fromIx n (i, j `mod` n))
 
 prop_toFromIx :: Positive Int -> NonNegative Int -> Bool
-prop_toFromIx (Positive n) (NonNegative k) = k == IV.fromIx n (IV.toIx n k)
+prop_toFromIx (Positive n) (NonNegative k) = k == fromIx n (toIx n k)
 
 prop_toFromVector
   :: Image VU Y Word8 -> Bool
-prop_toFromVector img = img == IV.fromUnboxedVector (IM.dims img) (IV.toUnboxedVector img)
+prop_toFromVector img = img == fromUnboxedVector (dims img) (toUnboxedVector img)
 
 spec :: Spec
 spec = do
diff --git a/tests/Graphics/Image/InterfaceSpec.hs b/tests/Graphics/Image/InterfaceSpec.hs
--- a/tests/Graphics/Image/InterfaceSpec.hs
+++ b/tests/Graphics/Image/InterfaceSpec.hs
@@ -10,6 +10,7 @@
   , Identical (..)
   ) where
 
+import Prelude as P
 #if MIN_VERSION_base(4,8,0)
 import Data.Typeable (Typeable, typeOf)
 #else
@@ -18,10 +19,8 @@
 import Test.Hspec
 import Test.QuickCheck
 
-import qualified Graphics.Image as IM
-import qualified Graphics.Image.Interface as I
-import Graphics.Image.Types
-import Graphics.Image.Processing
+import Graphics.Image as I
+import Graphics.Image.Interface as I
 
 
 data Identical arr1 arr2 cs e =
@@ -71,16 +70,15 @@
 
 
 instance Arbitrary px => Arbitrary (Border px) where
-  arbitrary = do
-    methodIx <- arbitrary
-    case methodIx `mod` 5 :: Int of
-      0 -> Fill <$> arbitrary
-      1 -> return Wrap
-      2 -> return Edge
-      3 -> return Reflect
-      4 -> return Continue
-      _ -> error "Unknown method"
-
+  arbitrary =
+    oneof
+      [ Fill <$> arbitrary
+      , return Wrap
+      , return Edge
+      , return Reflect
+      , return Continue
+      ]
+      
 
 #if MIN_VERSION_base(4,8,0)
 instance (Typeable a, Typeable b) => Show (a -> b) where
@@ -107,7 +105,7 @@
 prop_borderIndex border img (Positive i, Positive j) =
   I.borderIndex border img (iOut, jOut) == I.index bigImg (iBig, jBig)
   where
-    bigImg = foldr1 topToBottom $ map (foldr1 leftToRight) imgs
+    bigImg = foldr1 topToBottom $ P.map (foldr1 leftToRight) imgs
     (m, n) = I.dims img
     (iBig, jBig) = (i `mod` (3 * m), j `mod` (3 * n))
     (iOut, jOut) = (iBig - m, jBig - n)
@@ -163,69 +161,65 @@
     newPx getPx (i, j) = getPx ((i - dm) `mod` m, (j - dn) `mod` n)
 
 
-prop_toFormLists :: (Array arr Y Word8, MArray arr Y Word8) => arr -> Image arr Y Word8 -> Bool
-prop_toFormLists _ img = img == I.fromLists (IM.toLists img)
-
-
 prop_sameDims :: Array arr Y Word8 => arr -> Identical VU arr Y Word8 -> Bool
 prop_sameDims _ (Identical img1 img2) = I.dims img1 == I.dims img2
 
 prop_sameImage
-  :: (Exchangable arr RS, Array arr Y Word8)
-  => arr -> Identical VU arr Y Word8 -> Bool
-prop_sameImage _ (Identical img1 img2) = I.exchange RS img1 == I.exchange RS img2
+  :: (Exchangable arr VU, Array arr RGB Word8)
+  => arr -> Identical VU arr RGB Word8 -> Bool
+prop_sameImage _ (Identical img1 img2) = img1 == I.exchange VU img2
 
 prop_sameMap
-  :: (Exchangable arr RS, Array arr Y Word8)
+  :: (Exchangable arr RSU, Array arr Y Word8)
   => arr -> (Pixel Y Word8 -> Pixel Y Word8) -> Identical VU arr Y Word8 -> Bool
 prop_sameMap _ f (Identical img1 img2) =
-  I.exchange RS (I.map f img1) == I.exchange RS (I.map f img2)
+  I.exchange RSU (I.map f img1) == I.exchange RSU (I.map f img2)
 
 prop_sameImap
-  :: (Exchangable arr RP, Array arr Y Word8)
+  :: (Exchangable arr RPU, Array arr Y Word8)
   => arr -> ((Int, Int) -> Pixel Y Word8 -> Pixel Y Word8) -> Identical VU arr Y Word8 -> Bool
 prop_sameImap _ f (Identical img1 img2) =
-  I.exchange RP (I.imap f img1) == I.exchange RP (I.imap f img2)
+  I.exchange RPU (I.imap f img1) == I.exchange RPU (I.imap f img2)
 
 
 prop_sameZipWith
-  :: (Exchangable arr RP, Array arr Y Word8)
+  :: (Exchangable arr RPU, Array arr Y Word8)
   => arr
   -> (Pixel Y Word8 -> Pixel Y Word8)
   -> (Pixel Y Word8 -> Pixel Y Word8 -> Pixel Y Word8)
   -> Identical VU arr Y Word8
   -> Bool
 prop_sameZipWith _ g f (Identical img1 img2) =
-  I.exchange RP (I.zipWith f img1 img1') ==
-  I.exchange RP (I.zipWith f img2 img2')
+  I.exchange RPU (I.zipWith f img1 img1') ==
+  I.exchange RPU (I.zipWith f img2 img2')
   where
     img1' = I.map g img1
     img2' = I.map g img2
 
 prop_sameIZipWith
-  :: (Exchangable arr RP, Array arr Y Word8)
+  :: (Exchangable arr RPU, Array arr Y Word8)
   => arr
   -> (Pixel Y Word8 -> Pixel Y Word8)
   -> ((Int, Int) -> Pixel Y Word8 -> Pixel Y Word8 -> Pixel Y Word8)
   -> Identical VU arr Y Word8
   -> Bool
 prop_sameIZipWith _ g f (Identical img1 img2) =
-  I.exchange RP (I.izipWith f img1 img1') ==
-  I.exchange RP (I.izipWith f img2 img2')
+  I.exchange RPU (I.izipWith f img1 img1') ==
+  I.exchange RPU (I.izipWith f img2 img2')
   where
     img1' = I.map g img1
     img2' = I.map g img2
 
 prop_sameTraverse
-  :: (Exchangable arr RS, Array arr Y Word8)
+  :: (Exchangable arr RSU, Array arr Y Word8)
   => arr
   -> ((Int, Int) -> (Positive (Small Int), Positive (Small Int)))
   -> ((Int, Int) -> Pixel Y Word8 -> Pixel Y Word8)
   -> Identical VU arr Y Word8
   -> Bool
 prop_sameTraverse _ g f (Identical img1 img2) =
-  I.exchange RS (I.traverse img1 (g' . g) f') ==
-  I.exchange RS (I.traverse img2 (g' . g) f')
+  I.exchange RSU (I.traverse img1 (g' . g) f') ==
+  I.exchange RSU (I.traverse img2 (g' . g) f')
   where
     g' (Positive (Small i), Positive (Small j)) = (i, j)
     f' getPx ix@(i, j) = f ix (getPx (i `mod` m, j `mod` n))
@@ -233,7 +227,7 @@
 
 
 prop_sameTraverse2
-  :: (Exchangable arr RS, Array arr Y Word8)
+  :: (Exchangable arr RSU, Array arr Y Word8)
   => arr
   -> ((Int, Int) -> (Int, Int) -> (Positive (Small Int), Positive (Small Int)))
   -> ((Int, Int) -> Pixel Y Word8 -> Pixel Y Word8 -> Pixel Y Word8)
@@ -241,8 +235,8 @@
   -> Identical VU arr Y Word8
   -> Bool
 prop_sameTraverse2 _ g f (Identical img1a img2a) (Identical img1b img2b) =
-  I.exchange RS (I.traverse2 img1a img1b g' f') ==
-  I.exchange RS (I.traverse2 img2a img2b g' f')
+  I.exchange RSU (I.traverse2 img1a img1b g' f') ==
+  I.exchange RSU (I.traverse2 img2a img2b g' f')
   where
     g' dimsA dimsB =
       case g dimsA dimsB of
@@ -254,52 +248,66 @@
 
 
 prop_sameTranspose
-  :: (Exchangable arr RS, Array arr Y Word8)
+  :: (Exchangable arr RSU, Array arr Y Word8)
   => arr
   -> Identical VU arr Y Word8
   -> Bool
 prop_sameTranspose _ (Identical img1 img2) =
-  I.exchange RS (I.transpose img1) == I.exchange RS (I.transpose img2)
+  I.exchange RSU (I.transpose img1) == I.exchange RSU (I.transpose img2)
 
 
 prop_sameBackpermute
-  :: (Exchangable arr RP, Array arr Y Word8)
+  :: (Exchangable arr RPU, Array arr Y Word8)
   => arr
   -> (Positive (Small Int), Positive (Small Int))
   -> ((Int, Int) -> (Int, Int))
   -> Identical VU arr Y Word8
   -> Bool
 prop_sameBackpermute _ (Positive (Small m), Positive (Small n)) f (Identical img1 img2) =
-  I.exchange RP (I.backpermute (m, n) (f' . f) img1) ==
-  I.exchange RP (I.backpermute (m, n) (f' . f) img2)
+  I.exchange RPU (I.backpermute (m, n) (f' . f) img1) ==
+  I.exchange RPU (I.backpermute (m, n) (f' . f) img2)
   where
     (m', n') = I.dims img1
     f' (i, j) = (i `mod` m', j `mod` n')
 
 
+prop_toFormLists :: (Array arr Y Word8, MArray arr Y Word8) => arr -> Image arr Y Word8 -> Bool
+prop_toFormLists _ img = img == I.fromLists (I.toLists img)
+
+
 spec :: Spec
 spec = do
   describe "Interface Properties" $ do
     it "borderIndex" $ property prop_borderIndex
     it "toFormLists" $ property $ prop_toFormLists VU
   describe "Representation Properties" $ do
-    it "sameDims RS" $ property $ prop_sameDims RS
-    it "sameDims RP" $ property $ prop_sameDims RP
-    it "sameImage RS" $ property $ prop_sameImage RS
-    it "sameImage RP" $ property $ prop_sameImage RP
-    it "sameMap RS" $ property $ prop_sameMap RS
-    it "sameMap RP" $ property $ prop_sameMap RP
-    it "sameImap RS" $ property $ prop_sameImap RS
-    it "sameImap RP" $ property $ prop_sameImap RP
-    it "sameZipWith RS" $ property $ prop_sameZipWith RS
-    it "sameZipWith RP" $ property $ prop_sameZipWith RP
-    it "sameIZipWith RS" $ property $ prop_sameIZipWith RS
-    it "sameIZipWith RP" $ property $ prop_sameIZipWith RP
-    it "sameTraverse RS" $ property $ prop_sameTraverse RS
-    it "sameTraverse RP" $ property $ prop_sameTraverse RP
-    it "sameTraverse2 RS" $ property $ prop_sameTraverse2 RS
-    it "sameTraverse2 RP" $ property $ prop_sameTraverse2 RP
-    it "sameTranspose RS" $ property $ prop_sameTranspose RS
-    it "sameTranspose RP" $ property $ prop_sameTranspose RP
-    it "sameBackpermute RS" $ property $ prop_sameBackpermute RS
-    it "sameBackpermute RP" $ property $ prop_sameBackpermute RP
+    it "sameDims VS" $ property $ prop_sameDims VS
+    it "sameDims RSU" $ property $ prop_sameDims RSU
+    it "sameDims RPU" $ property $ prop_sameDims RPU
+    it "sameImage VS" $ property $ prop_sameImage VS
+    it "sameImage RSU" $ property $ prop_sameImage RSU
+    it "sameImage RPU" $ property $ prop_sameImage RPU
+    --it "sameMap VS" $ property $ prop_sameMap VS
+    it "sameMap RSU" $ property $ prop_sameMap RSU
+    it "sameMap RPU" $ property $ prop_sameMap RPU
+    --it "sameImap VS" $ property $ prop_sameImap VS
+    it "sameImap RSU" $ property $ prop_sameImap RSU
+    it "sameImap RPU" $ property $ prop_sameImap RPU
+    --it "sameZipWith VS" $ property $ prop_sameZipWith VS
+    it "sameZipWith RSU" $ property $ prop_sameZipWith RSU
+    it "sameZipWith RPU" $ property $ prop_sameZipWith RPU
+    --it "sameIZipWith VS" $ property $ prop_sameIZipWith VS
+    it "sameIZipWith RSU" $ property $ prop_sameIZipWith RSU
+    it "sameIZipWith RPU" $ property $ prop_sameIZipWith RPU
+    --it "sameTraverse VS" $ property $ prop_sameTraverse VS
+    it "sameTraverse RSU" $ property $ prop_sameTraverse RSU
+    it "sameTraverse RPU" $ property $ prop_sameTraverse RPU
+    --it "sameTraverse2 VS" $ property $ prop_sameTraverse2 VS
+    it "sameTraverse2 RSU" $ property $ prop_sameTraverse2 RSU
+    it "sameTraverse2 RPU" $ property $ prop_sameTraverse2 RPU
+    --it "sameTranspose VS" $ property $ prop_sameTranspose VS
+    it "sameTranspose RSU" $ property $ prop_sameTranspose RSU
+    it "sameTranspose RPU" $ property $ prop_sameTranspose RPU
+    --it "sameBackpermute VS" $ property $ prop_sameBackpermute VS
+    it "sameBackpermute RSU" $ property $ prop_sameBackpermute RSU
+    it "sameBackpermute RPU" $ property $ prop_sameBackpermute RPU
diff --git a/tests/Graphics/Image/Processing/BinarySpec.hs b/tests/Graphics/Image/Processing/BinarySpec.hs
new file mode 100644
--- /dev/null
+++ b/tests/Graphics/Image/Processing/BinarySpec.hs
@@ -0,0 +1,132 @@
+{-# LANGUAGE FlexibleContexts #-}
+module Graphics.Image.Processing.BinarySpec (spec) where
+
+import Test.Hspec
+
+import Graphics.Image as I
+
+
+figure :: Image VU Binary Bit
+figure =
+  fromLists
+    [ [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 1, 1, 1, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 1, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 1, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    ]
+struct :: Image VU Binary Bit
+struct = fromLists [[0,1,0],[1,1,0],[0,1,0]]
+
+
+eroded :: Image VU Binary Bit
+eroded =
+  fromLists
+    [ [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    ]
+
+dialated :: Image VU Binary Bit
+dialated =
+  fromLists
+    [ [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 1, 1, 1, 0]
+    , [0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 1, 1, 1, 1, 0]
+    , [0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 1, 0, 1, 1, 0, 0, 0]
+    , [0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 0, 0, 0]
+    , [0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 0, 0, 1, 0, 0, 0]
+    , [0, 0, 0, 1, 1, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 1, 1, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 1, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    ]
+
+
+opened :: Image VU Binary Bit
+opened =
+  fromLists
+    [ [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    ]
+
+
+closed :: Image VU Binary Bit
+closed =
+  fromLists
+    [ [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+    ]
+
+
+
+spec :: Spec
+spec = do
+  describe "Morphology Spec" $
+    do it "erode" (erode struct figure `shouldBe` eroded)
+       it "dialate" (dialate struct figure `shouldBe` dialated)
+       it "open" (open struct figure `shouldBe` opened)
+       it "close" (close struct figure `shouldBe` closed)       
diff --git a/tests/Graphics/Image/ProcessingSpec.hs b/tests/Graphics/Image/ProcessingSpec.hs
--- a/tests/Graphics/Image/ProcessingSpec.hs
+++ b/tests/Graphics/Image/ProcessingSpec.hs
@@ -9,6 +9,7 @@
 import Graphics.Image.Processing
 
 import Graphics.Image.InterfaceSpec (translateWrap, dummyImage10x20)
+--import Graphics.Image.Processing.BinarySpec
 
 data Interpol
   = I1 Nearest