diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,10 +1,18 @@
 1.5.2.0
 =======
 
+* Fixed FFT performace issue
+* Reduced JuicyPixels module compile time and introduced conversion functions.
+* Created `Filter` and implemented few filters: `gaussianBlur`
+* Indroduced `Seq` format wrapper for sequence of images (eg. animated GIFs)
+
+1.5.2.0
+=======
+
 * Fixed `Storable` instance for some Pixel types.
 * Fixed reading/writing animated GIFs. Added a detailed example to documentation.
-* Improved encodeing/decoding of images.
-* Improved coversion between `ColorSpace`s. 
+* Improved encoding/decoding of images.
+* Improved coversion between `ColorSpace`s.
 
 1.5.1.0
 =======
@@ -21,10 +29,12 @@
 
 * Refactored `Gray` color space to be `X`, in order to reflect it's generality
 * Renamed few core functions:
+
   * `mapPx` -> `liftPx`,
   * `zipWithPx` -> `liftPx2`,
   * `broadcastC` -> `promote`,
   * `singleton` -> `scalar`.
+
 * `upsample`/`downsample` functions are now a lot more general.
 
 
@@ -52,7 +62,7 @@
   * 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
 =======
 
@@ -84,8 +94,8 @@
   * OS default image viewer is used for displaying images with ability to use a custom one.
   * Histogram plotting is done using diagrams instead of cairo backend,
     significantly simplifying installation
-    
 
+
 1.0.2.0
 =======
 
@@ -110,5 +120,3 @@
 
 * Made it compatible with GHC >= 7.4 (#1)
 * Added histogram plotting using Charts
-
-
diff --git a/benchmarks/Canny.hs b/benchmarks/Canny.hs
deleted file mode 100644
--- a/benchmarks/Canny.hs
+++ /dev/null
@@ -1,100 +0,0 @@
-{-# 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 as R
-import Data.Array.Repa.Repr.Unboxed as R
-import Data.Array.Repa.Stencil as R
-import Data.Array.Repa.Stencil.Dim2 as R
-import Data.Array.Repa.Algorithms.Convolve as R
--- import Graphics.Image.Interface.Vector
-
-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]])
-
-sobelGxSep :: I.Array arr cs e => Image arr cs e -> Image arr cs e
-sobelGxSep =
-  convolveCols Edge [1, 2, 1] . convolveRows Edge [1, 0, -1]
-
-sobelGySep :: I.Array arr cs e => Image arr cs e -> Image arr cs e
-sobelGySep =
-  convolveCols Edge [1, 0, -1] . convolveRows Edge [1, 2, 1]
-
-
-sobelGxRAlg :: (Unbox e, Num e, Monad m) => R.Array U DIM2 e -> m (R.Array U DIM2 e)
-sobelGxRAlg =
-  convolveOutP outClamp (R.fromListUnboxed (Z :. 3 :. 3) [-1, 0, 1, -2, 0, 2, -1, 0, 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/frog.jpg"
-  -- let !imgU = compute img'
-  let _foo = GIFALooping
-  let !imgU = compute $ makeImage (1024, 768)
-              (\(i, j) -> fromIntegral ((min i j) `div` (1 + max i j )))
-              :: Image RPU Y Word8
-  let sobelU = sobelGx imgU
-  let sobelSepU = sobelGxSep imgU
-  let !imgR = toRepaArray imgU
-  let sobelR = sobelGxR imgR
-  let sobelRAlg = sobelGxRAlg imgR
-  defaultMain
-    [ bgroup
-        "Sobel"
-        [
-          bench "naive U" $ whnf compute sobelU
-        , bench "separated U" $ whnf compute sobelSepU
-        , bench "repa U Agorithms" $ whnfIO sobelRAlg
-        , bench "repa U Stencil" $ whnfIO (force sobelR)
-        ]
-    ]
-
diff --git a/benchmarks/Convolution.hs b/benchmarks/Convolution.hs
new file mode 100644
--- /dev/null
+++ b/benchmarks/Convolution.hs
@@ -0,0 +1,108 @@
+{-# LANGUAGE BangPatterns          #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+module Main where
+
+import           Control.Monad
+import           Criterion.Main
+import           Data.Array.Repa                     as R
+import           Data.Array.Repa.Algorithms.Convolve as R
+import           Data.Array.Repa.Eval                as R
+import           Data.Array.Repa.Repr.Unboxed        as R
+import           Data.Array.Repa.Stencil             as R
+import           Data.Array.Repa.Stencil.Dim2        as R
+
+import           Graphics.Image                      as I
+import           Graphics.Image.Interface            as I
+import           Graphics.Image.Interface.Repa
+import           Prelude                             as P
+
+-- | Convolution
+sobelGx :: (I.Array arr X e, 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]])
+
+
+-- | Same convolution by separable
+sobelGxSep :: (I.Array arr X e, I.Array arr cs e) => Image arr cs e -> Image arr cs e
+sobelGxSep =
+  convolveCols Edge [1, 2, 1] . convolveRows Edge [1, 0, -1]
+
+
+-- | Repa algorithms convolution implementation
+sobelGxRAlg :: (Unbox e, Num e, Monad m) => R.Array U DIM2 e -> m (R.Array U DIM2 e)
+sobelGxRAlg =
+  convolveOutP outClamp (R.fromListUnboxed (Z :. 3 :. 3) [-1, 0, 1, -2, 0, 2, -1, 0, 1])
+
+-- | Repa algorithms convolution implementation - separable
+sobelGxRAlgSep :: (Unbox e, Num e, Monad m) => R.Array U DIM2 e -> m (R.Array U DIM2 e)
+sobelGxRAlgSep =
+  convolveOutP
+    outClamp
+    (R.fromListUnboxed (Z :. 1 :. 3) [1, 0, -1]) >=>
+  convolveOutP
+    outClamp
+    (R.fromListUnboxed (Z :. 3 :. 1) [1, 2, 1])
+
+
+-- |  Repa stencil base convolution
+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)
+
+forceP
+  :: (Load r1 sh e, Unbox e, Monad m)
+  => R.Array r1 sh e -> m (R.Array U sh e)
+forceP !arr = do
+    forcedArr <- computeUnboxedP arr
+    forcedArr `deepSeqArray` return forcedArr
+
+forceS
+  :: (Load r1 sh e, Unbox e, Monad m)
+  => R.Array r1 sh e -> m (R.Array U sh e)
+forceS !arr = do
+    forcedArr <- return $ computeS arr
+    forcedArr `deepSeqArray` return forcedArr
+
+
+
+main :: IO ()
+main = do
+  let !imgU = compute $ makeImage (1600, 1600)
+              (\(i, j) -> fromIntegral ((min i j) `div` (1 + max i j )))
+              :: Image RPU Y Double
+  let !imgU' =
+        compute $
+        makeImage
+          (1600, 1600)
+          (\(i, j) -> fromIntegral ((min i j) `div` (1 + max i j))) :: Image VU Y Double
+  let !sobelFSep = applyFilter (sobelFilter Horizontal Edge) imgU
+  let !sobelFSep' = applyFilter (sobelFilter Horizontal Edge)
+  let !imgR = toRepaArray imgU
+  let sobelR = sobelGxR imgR
+  let sobelRAlgSep = sobelGxRAlgSep imgR
+  defaultMain
+    [ bgroup
+        -- "Gaussian"
+        -- [ bench "Native VU" $ whnf (applyFilter gb) imgU'
+        -- ]
+        "Sobel"
+        [
+        --   bench "naive U" $ whnf compute sobelU
+          bench "repa R Stencil" $ whnfIO (forceP sobelR)
+        , bench "Filter R" $ whnf compute sobelFSep
+        , bench "Filter VU" $ whnf sobelFSep' imgU'
+        , bench "repa R Agorithms Separated" $ whnfIO sobelRAlgSep
+        ]
+    ]
diff --git a/benchmarks/Histogram.hs b/benchmarks/Histogram.hs
new file mode 100644
--- /dev/null
+++ b/benchmarks/Histogram.hs
@@ -0,0 +1,28 @@
+{-# 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
+
+
+
+
+main :: IO ()
+main = do
+  let toX (PixelY y) = PixelX y
+  let !imgY =
+        compute $
+        makeImage
+          (1024, 768)
+          (\(i, j) -> fromIntegral ((min i j) `div` (1 + max i j))) :: Image VU Y Double
+  defaultMain
+    [ bgroup
+        "Histogram"
+        [ bench "Compute All" $ nf (hBins . head . getHistograms) imgY
+        , bench "Compute Direct " $ nf (hBins . getHistogram . I.map toX) imgY
+        , bench "Equalize" $ nf equalizeHistogram imgY
+        ]
+    ]
diff --git a/hip.cabal b/hip.cabal
--- a/hip.cabal
+++ b/hip.cabal
@@ -1,5 +1,5 @@
 Name:              hip
-Version:           1.5.2.0
+Version:           1.5.3.0
 License:           BSD3
 License-File:      LICENSE
 Author:            Alexey Kuleshevich
@@ -66,6 +66,7 @@
                  , Graphics.Image.Processing
                  , Graphics.Image.Processing.Binary
                  , Graphics.Image.Processing.Complex
+                 , Graphics.Image.Processing.Filter
                  , Graphics.Image.Types
   Other-Modules:   Graphics.Image.ColorSpace.Binary
                  , Graphics.Image.ColorSpace.CMYK
@@ -76,15 +77,12 @@
                  , Graphics.Image.ColorSpace.Y
                  , Graphics.Image.ColorSpace.YCbCr
                  , Graphics.Image.IO.Base
-                 , Graphics.Image.IO.Formats.JuicyPixels.Common
-                 , Graphics.Image.IO.Formats.JuicyPixels.Readable
-                 , Graphics.Image.IO.Formats.JuicyPixels.Writable
+                 , Graphics.Image.IO.Formats.JuicyPixels
                  , Graphics.Image.IO.Formats.Netpbm
                  , Graphics.Image.Interface.Elevator
                  , 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
@@ -93,6 +91,7 @@
                  , Graphics.Image.Processing.Complex.Fourier
                  , Graphics.Image.Processing.Geometric
                  , Graphics.Image.Processing.Interpolation
+                 , Graphics.Image.Utils
   GHC-Options:     -Wall
   if os(windows)
     CPP-Options:      -DOS_Win32
@@ -126,17 +125,28 @@
 benchmark convolution
   type:                exitcode-stdio-1.0
   hs-source-dirs:      benchmarks
-  main-is:             Canny.hs
-  ghc-options:         -threaded -rtsopts -with-rtsopts=-N -O2
+  main-is:             Convolution.hs
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N6 -O2
   build-depends:       base
                      , criterion
                      , deepseq
                      , repa
                      , repa-algorithms
                      , hip
+                     , vector
   default-language:    Haskell2010
 
-                       
+benchmark histogram
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      benchmarks
+  main-is:             Histogram.hs
+  ghc-options:         -threaded -O2
+  build-depends:       base
+                     , criterion
+                     , hip
+  default-language:    Haskell2010
+
+
 Source-Repository head
   Type:     git
   Location: https://github.com/lehins/hip.git
diff --git a/src/Graphics/Image.hs b/src/Graphics/Image.hs
--- a/src/Graphics/Image.hs
+++ b/src/Graphics/Image.hs
@@ -3,7 +3,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 -- |
 -- Module      : Graphics.Image
--- Copyright   : (c) Alexey Kuleshevich 2016
+-- Copyright   : (c) Alexey Kuleshevich 2017
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -98,9 +98,10 @@
   -- ** Geometric
   I.traverse, traverse2,
   transpose, backpermute,
-  (|*|), 
+  (|*|),
   -- * Reduction
   fold, sum, product, maximum, minimum, normalize, eqTol,
+  -- * Manifest Image
   -- * Representations
   exchange,
   module IP
@@ -139,13 +140,13 @@
 --
 -- <<images/grad_gray.png>> <<images/grad_color.png>>
 --
-makeImageR :: Array arr cs Double =>
+makeImageR :: Array arr cs e =>
               arr -- ^ Underlying image representation.
            -> (Int, Int) -- ^ (@m@ rows, @n@ columns) - dimensions of a new image.
-           -> ((Int, Int) -> Pixel cs Double)
+           -> ((Int, Int) -> Pixel cs e)
            -- ^ 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
+           -> Image arr cs e
 makeImageR _ = I.makeImage
 {-# INLINE makeImageR #-}
 
@@ -238,7 +239,7 @@
 -- | Check weather two images are equal within a tolerance. Useful for comparing
 -- images with `Float` or `Double` precision.
 eqTol
-  :: (Array arr Binary Bit, Array arr cs e, Ord e) =>
+  :: (Array arr X Bit, Array arr cs e, Ord e) =>
      e -> Image arr cs e -> Image arr cs e -> Bool
 eqTol !tol !img1 = IP.and . toImageBinaryUsing2 (eqTolPx tol) img1
 {-# INLINE eqTol #-}
@@ -272,9 +273,9 @@
 --     * __'Pixel' 'YCbCr' e  = PixelYCbCr y cb cr__    - Luma, blue-difference and red-difference chromas.
 --     * __'Pixel' 'YCbCrA' e = PixelYCbCrA y cb cr a__ - YCbCr with alpha.
 --       ------------------------------------------------------------------------------------------
---     * __'Pixel' 'Binary' 'Bit'     = 'on' | 'off'__ - Bi-tonal.
+--     * __'Pixel' 'X' 'Bit'          = 'on' | 'off'__ - Bi-tonal.
 --     * __'Pixel' cs ('Complex' e) = ('Pixel' cs e) '+:' ('Pixel' cs e)__ - Complex pixels with any color space.
---     * __'Pixel' 'X' e         = PixelX g__ - Used for separating channels from other color spaces.
+--     * __'Pixel' 'X' e         = PixelX g__ - Used to represent binary images as well as any other single channel colorspace, for instance to separate channels from other color spaces into standalone images.
 -- @
 --
 -- Every 'Pixel' is an instance of 'Functor', 'Applicative', 'F.Foldable' and
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
@@ -1,12 +1,12 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE BangPatterns          #-}
+{-# LANGUAGE CPP                   #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE UndecidableInstances  #-}
+{-# LANGUAGE ViewPatterns          #-}
 #if __GLASGOW_HASKELL__ >= 800
   {-# OPTIONS_GHC -Wno-redundant-constraints #-}
 #endif
@@ -21,9 +21,9 @@
 module Graphics.Image.ColorSpace (
   -- * Pixels
   -- ** Family of Pixels
-  -- | Pixel is a type family for all available color spaces. Below will be
-  -- listed all class instances pixels are installed in, as well as all pixel
-  -- constructors.
+  -- | Pixel is a type family for all available color spaces. Below is the
+  -- listed of all class instances, that pixels are installed in, as well as all
+  -- pixel constructors.
   --
   -- >>> :t (PixelY 0) -- Black pixel in Luma
   -- (PixelY 0) :: Num e => Pixel Y e
@@ -78,11 +78,12 @@
   -- >>> (on + on) - on
   -- <Binary:(0)>
   --
-  on, off, isOn, isOff, one, zero, fromBool, complement,
   toPixelBinary, fromPixelBinary, toImageBinary, fromImageBinary,
+  module Graphics.Image.ColorSpace.Binary,
   -- ** Complex
   module Graphics.Image.ColorSpace.Complex,
   -- ** X
+  squashWith, squashWith2,
   toPixelsX, fromPixelsX,
   toImagesX, fromImagesX,
   -- * ColorSpace
@@ -103,44 +104,57 @@
   -- ** YCbCr
   YCbCr(..), YCbCrA(..),
   ToYCbCr, ToYCbCrA,
-  -- ** Binary
-  Binary(..), Bit, 
   -- ** X
   X(..),
-  -- * Useful re-exports
+  -- * Precision
+  -- ** Image
+  toWord8I,
+  toWord16I,
+  toWord32I,
+  toFloatI,
+  toDoubleI,
+  -- ** Pixel
+  toWord8Px,
+  -- ** Componenet
   Word8, Word16, Word32, Word64
   ) where
 
-import Data.Word
-import Graphics.Image.Interface as I
-import Graphics.Image.ColorSpace.Binary
-import Graphics.Image.ColorSpace.RGB
-import Graphics.Image.ColorSpace.HSI
-import Graphics.Image.ColorSpace.CMYK
-import Graphics.Image.ColorSpace.X
-import Graphics.Image.ColorSpace.Y
-import Graphics.Image.ColorSpace.YCbCr
-import Graphics.Image.ColorSpace.Complex
+import           Data.Word
+import           Graphics.Image.ColorSpace.Binary
+import           Graphics.Image.ColorSpace.CMYK
+import           Graphics.Image.ColorSpace.Complex
+import           Graphics.Image.ColorSpace.HSI
+import           Graphics.Image.ColorSpace.RGB
+import           Graphics.Image.ColorSpace.X
+import           Graphics.Image.ColorSpace.Y
+import           Graphics.Image.ColorSpace.YCbCr
+import           Graphics.Image.Interface          as I
+import           Graphics.Image.Interface.Elevator
 
 
--- Binary:
+-- -- Binary:
 
--- | Convert to a `Binary` image.
-toImageBinary :: (Array arr cs e, Array arr Binary Bit) =>
-                 Image arr cs e
-              -> Image arr Binary Bit
-toImageBinary = I.map toPixelBinary
-{-# INLINE toImageBinary #-}
+-- | Convert to a `Binary` pixel.
+toPixelBinary :: ColorSpace cs e => Pixel cs e -> Pixel X Bit
+toPixelBinary px = if px == 0 then on else off
 
+
 -- | Convert a Binary pixel to Luma pixel
-fromPixelBinary :: Pixel Binary Bit -> Pixel Y Word8
+fromPixelBinary :: Pixel X Bit -> Pixel Y Word8
 fromPixelBinary b = PixelY $ if isOn b then minBound else maxBound
 {-# INLINE fromPixelBinary #-}
 
+-- | Convert to a `Binary` image.
+toImageBinary :: (Array arr cs e, Array arr X Bit) =>
+                 Image arr cs e
+              -> Image arr X Bit
+toImageBinary = I.map toPixelBinary
+{-# INLINE toImageBinary #-}
 
+
 -- | Convert a Binary image to Luma image
-fromImageBinary :: (Array arr Binary Bit, Array arr Y Word8) =>
-                   Image arr Binary Bit
+fromImageBinary :: (Array arr X Bit, Array arr Y Word8) =>
+                   Image arr X Bit
                 -> Image arr Y Word8
 fromImageBinary = I.map fromPixelBinary
 {-# INLINE fromImageBinary #-}
@@ -150,7 +164,7 @@
 -- pixels with `Float` or `Double` precision.
 eqTolPx :: (ColorSpace cs e, Ord e) =>
            e -> Pixel cs e -> Pixel cs e -> Bool
-eqTolPx !tol = foldlPx2 comp True 
+eqTolPx !tol = foldlPx2 comp True
   where comp !acc !e1 !e2 = acc && max e1 e2 - min e1 e2 <= tol
         {-# INLINE comp #-}
 {-# INLINE eqTolPx #-}
@@ -175,10 +189,6 @@
   toPixelY (PixelX y) = PixelY $ toDouble y
   {-# INLINE toPixelY #-}
 
-instance ToY Binary Bit where
-  toPixelY (PixelBinary b) = PixelY $ toDouble b
-  {-# INLINE toPixelY #-}
-
 instance Elevator e => ToY Y e where
   toPixelY (PixelY y) = PixelY $ toDouble y
   {-# INLINE toPixelY #-}
@@ -238,13 +248,14 @@
 toImageYA = I.map toPixelYA
 {-# INLINE toImageYA #-}
 
-                                
-instance ToY Y e => ToYA Y e
 
-instance ToYA Binary Bit where
-  toPixelYA(PixelBinary b) = PixelYA (toDouble b) 1
+instance ToYA X Bit where
+  toPixelYA (PixelX y) = PixelYA (toDouble y) 1
   {-# INLINE toPixelYA #-}
 
+
+instance ToY Y e => ToYA Y e
+
 instance Elevator e => ToYA YA e where
   toPixelYA = fmap toDouble
   {-# INLINE toPixelYA #-}
@@ -290,8 +301,8 @@
 {-# INLINE toImageRGB #-}
 
 
-instance ToRGB Binary Bit where
-  toPixelRGB (PixelBinary b) = pure $ toDouble b
+instance ToRGB X Bit where
+  toPixelRGB (PixelX b) = pure $ toDouble b
   {-# INLINE toPixelRGB #-}
 
 instance Elevator e => ToRGB Y e where
@@ -343,9 +354,9 @@
 
 instance Elevator e => ToRGB YCbCr e where
   toPixelRGB (fmap toDouble -> PixelYCbCr y cb cr) = PixelRGB r g b where
-    !r = y                      +   1.402*(cr - 0.5)
-    !g = y - 0.34414*(cb - 0.5) - 0.71414*(cr - 0.5)
-    !b = y +   1.772*(cb - 0.5)
+    !r = clamp01 (y                      +   1.402*(cr - 0.5))
+    !g = clamp01 (y - 0.34414*(cb - 0.5) - 0.71414*(cr - 0.5))
+    !b = clamp01 (y +   1.772*(cb - 0.5))
   {-# INLINE toPixelRGB #-}
 
 instance Elevator e => ToRGB YCbCrA e where
@@ -382,7 +393,7 @@
 {-# INLINE toImageRGBA #-}
 
 
-instance ToRGBA Binary Bit
+instance ToRGBA X Bit
 
 instance ToRGB Y e => ToRGBA Y e
 
@@ -430,7 +441,7 @@
 toImageHSI = I.map toPixelHSI
 {-# INLINE toImageHSI #-}
 
-  
+
 instance Elevator e => ToHSI Y e where
   toPixelHSI (PixelY y) = PixelHSI 0 0 $ toDouble y
   {-# INLINE toPixelHSI #-}
@@ -667,9 +678,9 @@
 
 instance Elevator e => ToYCbCr RGB e where
   toPixelYCbCr (fmap toDouble -> PixelRGB r g b) = PixelYCbCr y cb cr where
-    !y  =          0.299*r +    0.587*g +    0.114*b
-    !cb = 0.5 - 0.168736*r - 0.331264*g +      0.5*b
-    !cr = 0.5 +      0.5*r - 0.418688*g - 0.081312*b
+    !y  = clamp01 (         0.299*r +    0.587*g +    0.114*b)
+    !cb = clamp01 (0.5 - 0.168736*r - 0.331264*g +      0.5*b)
+    !cr = clamp01 (0.5 +      0.5*r - 0.418688*g - 0.081312*b)
   {-# INLINE toPixelYCbCr #-}
 
 instance Elevator e => ToYCbCr RGBA e where
@@ -719,8 +730,8 @@
 toImageYCbCrA = I.map toPixelYCbCrA
 {-# INLINE toImageYCbCrA #-}
 
- 
 
+
 instance ToYCbCr Y e => ToYCbCrA Y e
 
 instance Elevator e => ToYCbCrA YA e where
@@ -752,4 +763,47 @@
   toPixelYCbCrA = fmap toDouble
   {-# INLINE toPixelYCbCrA #-}
 
+
+-- | Change image precision to `Word8`.
+toWord8I :: (Functor (Pixel cs), Array arr cs e, Array arr cs Word8)
+         => Image arr cs e -> Image arr cs Word8
+toWord8I = I.map (fmap toWord8)
+{-# INLINABLE toWord8I #-}
+
+{-
+{-# SPECIALIZE toWord8I :: (Array arr Y Double, Array arr Y Word8) => Image arr Y Double -> Image arr Y Word8 #-}
+{-# SPECIALIZE toWord8I :: (Array arr YA Double, Array arr YA Word8) => Image arr YA Double -> Image arr YA Word8 #-}
+{-# SPECIALIZE toWord8I :: (Array arr RGB Double, Array arr RGB Word8) => Image arr RGB Double -> Image arr RGB Word8 #-}
+{-# SPECIALIZE toWord8I :: (Array arr RGBA Double, Array arr RGBA Word8) => Image arr RGBA Double -> Image arr RGBA Word8 #-}
+-}
+-- | Change image precision to `Word16`.
+toWord16I :: (Functor (Pixel cs), Array arr cs e, Array arr cs Word16)
+         => Image arr cs e -> Image arr cs Word16
+toWord16I = I.map (fmap toWord16)
+{-# INLINABLE toWord16I #-}
+
+-- | Change image precision to `Word32`.
+toWord32I :: (Functor (Pixel cs), Array arr cs e, Array arr cs Word32)
+         => Image arr cs e -> Image arr cs Word32
+toWord32I = I.map (fmap toWord32)
+{-# INLINABLE toWord32I #-}
+
+-- | Change image precision to `Float`.
+toFloatI :: (Functor (Pixel cs), Array arr cs e, Array arr cs Float)
+         => Image arr cs e -> Image arr cs Float
+toFloatI = I.map (fmap toFloat)
+{-# INLINABLE toFloatI #-}
+
+-- | Change image precision to `Double`.
+toDoubleI :: (Functor (Pixel cs), Array arr cs e, Array arr cs Double)
+         => Image arr cs e -> Image arr cs Double
+toDoubleI = I.map (fmap toDouble)
+{-# INLINABLE toDoubleI #-}
+
+
+
+-- | Change pixel precision to `Word8`.
+toWord8Px :: (Functor (Pixel cs), Elevator e) => Pixel cs e -> Pixel cs Word8
+toWord8Px = fmap toWord8
+{-# INLINABLE toWord8Px #-}
 
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
@@ -1,131 +1,130 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE BangPatterns          #-}
+{-# LANGUAGE CPP                   #-}
+{-# LANGUAGE DeriveDataTypeable    #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeFamilies          #-}
 -- |
 -- Module      : Graphics.Image.ColorSpace.Binary
--- 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.Binary (
-  Binary(..), Bit(..), Pixel(..), on, off, isOn, isOff, fromBool, zero, one,
-  toPixelBinary,
-  module Data.Bits
+  Bit(..), on, off, isOn, isOff, fromBool, zero, one, bit2bool, bool2bit, toNum, fromNum
   ) where
 
-import Prelude hiding (map)
-import Control.Monad
-import Data.Bits
-import Data.Word (Word8)
-import Data.Typeable (Typeable)
-import Foreign.Ptr
-import Foreign.Storable
-import qualified Data.Vector.Generic            as V
-import qualified Data.Vector.Generic.Mutable    as M
-import qualified Data.Vector.Unboxed            as U
-import Graphics.Image.Interface
-
-
--- | Binary Color Space, also known as bi-tonal.
-data Binary = Binary deriving (Eq, Enum, Bounded, Show, Typeable)
+import           Control.Monad
+import           Data.Bits
+import           Data.Typeable               (Typeable)
+import qualified Data.Vector.Generic         as V
+import qualified Data.Vector.Generic.Mutable as M
+import qualified Data.Vector.Unboxed         as U
+import           Data.Word                   (Word8)
+import           Foreign.Ptr
+import           Foreign.Storable
+import           Graphics.Image.ColorSpace.X
+import           Graphics.Image.Interface
+import           Prelude                     hiding (map)
 
 
--- | Under the hood, Binary pixels are represented as 'Word8', but can only take
--- values of @0@ or @1@.
+-- | Under the hood, binary pixels are represented as `Word8`, but can only take
+-- values of @0@ or @1@. Use `zero`\/`one` to construct a bit and `on`\/`off` to
+-- construct a binary pixel.
 newtype Bit = Bit Word8 deriving (Ord, Eq, Typeable)
 
-newtype instance Pixel Binary Bit = PixelBinary Bit deriving (Ord, Eq)
 
-
--- | Convert to a `Binary` pixel.
-toPixelBinary :: ColorSpace cs e => Pixel cs e -> Pixel Binary Bit
-toPixelBinary px = if px == 0 then on else off
-
-
-instance Show (Pixel Binary Bit) where
-  show (PixelBinary (Bit 0)) = "<Binary:(0)>"
-  show _                     = "<Binary:(1)>"
+instance Show Bit where
+  show (Bit 0) = "0"
+  show _       = "1"
 
 
 instance Bits Bit where
-  (.&.) = (*)
+  (Bit 0) .&. _       = Bit 0
+  (Bit 1) .&. (Bit 1) = Bit 1
+  _       .&. (Bit 0) = Bit 0
+  _       .&. _       = Bit 1
   {-# INLINE (.&.) #-}
-
-  (.|.) = (+)
+  (Bit 1) .|. _       = Bit 1
+  (Bit 0) .|. (Bit 0) = Bit 0
+  _       .|. _       = Bit 1
   {-# INLINE (.|.) #-}
-
   (Bit 0) `xor` (Bit 0) = Bit 0
   (Bit 1) `xor` (Bit 1) = Bit 0
   _       `xor` _       = Bit 1
   {-# INLINE xor #-}
-
   complement (Bit 0) = Bit 1
   complement       _ = Bit 0
-
+  {-# INLINE complement #-}
   shift !b 0 = b
   shift  _ _ = Bit 0
-  
+  {-# INLINE shift #-}
   rotate !b _ = b
-
+  {-# INLINE rotate #-}
   zeroBits = Bit 0
-
+  {-# INLINE zeroBits #-}
   bit 0 = Bit 1
   bit _ = Bit 0
-
+  {-# INLINE bit #-}
   testBit (Bit 1) 0 = True
   testBit _       _ = False
-
+  {-# INLINE testBit #-}
   bitSizeMaybe _ = Just 1
-
+  {-# INLINE bitSizeMaybe #-}
   bitSize _ = 1
-
+  {-# INLINE bitSize #-}
   isSigned _ = False
-
+  {-# INLINE isSigned #-}
   popCount (Bit 0) = 0
   popCount _       = 1
-
+  {-# INLINE popCount #-}
 
 
-instance Bits (Pixel Binary Bit) where
+instance Bits (Pixel X Bit) where
   (.&.) = liftPx2 (.&.)
   {-# INLINE (.&.) #-}
-
   (.|.) = liftPx2 (.|.)
   {-# INLINE (.|.) #-}
-
   xor = liftPx2 xor
   {-# INLINE xor #-}
-
   complement = liftPx complement
-
+  {-# INLINE complement #-}
   shift !b !n = liftPx (`shift` n) b
-  
+  {-# INLINE shift #-}
   rotate !b !n = liftPx (`rotate` n) b
-
+  {-# INLINE rotate #-}
   zeroBits = promote zeroBits
-
+  {-# INLINE zeroBits #-}
   bit = promote . bit
-
-  testBit (PixelBinary (Bit 1)) 0 = True
-  testBit _                     _ = False
-
+  {-# INLINE bit #-}
+  testBit (PixelX (Bit 1)) 0 = True
+  testBit _                _ = False
+  {-# INLINE testBit #-}
   bitSizeMaybe _ = Just 1
-
+  {-# INLINE bitSizeMaybe #-}
   bitSize _ = 1
-
+  {-# INLINE bitSize #-}
   isSigned _ = False
+  {-# INLINE isSigned #-}
+  popCount (PixelX (Bit 0)) = 0
+  popCount _                = 1
+  {-# INLINE popCount #-}
 
-  popCount (PixelBinary (Bit 0)) = 0
-  popCount _                     = 1
+toNum :: Num a => Bit -> a
+toNum (Bit 0) = 0
+toNum _       = 1
+{-# INLINE toNum #-}
 
+fromNum :: (Eq a, Num a) => a -> Bit
+fromNum 0 = zero
+fromNum _ = one
+{-# INLINE fromNum #-}
 
+
 zero :: Bit
 zero = Bit 0
 {-# INLINE zero #-}
@@ -134,69 +133,54 @@
 one = Bit 1
 {-# INLINE one #-}
 
+bool2bit :: Bool -> Bit
+bool2bit False = zero
+bool2bit True = one
+{-# INLINE bool2bit #-}
+
+bit2bool :: Bit -> Bool
+bit2bool (Bit 0) = False
+bit2bool _       = True
+{-# INLINE bit2bool #-}
+
 -- | Represents value 'True' or @1@ in binary. Often also called a foreground
 -- pixel of an object.
-on :: Pixel Binary Bit
-on = PixelBinary one
+on :: Pixel X Bit
+on = PixelX one
 {-# INLINE on #-}
 
 
 -- | Represents value 'False' or @0@ in binary. Often also called a background
 -- pixel.
-off :: Pixel Binary Bit
-off = PixelBinary zero
+off :: Pixel X Bit
+off = PixelX zero
 {-# INLINE off #-}
 
 
--- | Convert a 'Bool' to a 'PixelBin' pixel.
+-- | Convert a 'Bool' to a binary pixel.
 --
 -- >>> isOn (fromBool True)
 -- True
 --
-fromBool :: Bool -> Pixel Binary Bit
+fromBool :: Bool -> Pixel X Bit
 fromBool False = off
 fromBool True  = on
 {-# INLINE fromBool #-}
 
 
 -- | Test if Pixel's value is 'on'.
-isOn :: Pixel Binary Bit -> Bool
-isOn (PixelBinary (Bit 0)) = False
-isOn _                     = True
+isOn :: Pixel X Bit -> Bool
+isOn (PixelX (Bit 0)) = False
+isOn _                = True
 {-# INLINE isOn #-}
 
 
 -- | Test if Pixel's value is 'off'.
-isOff :: Pixel Binary Bit -> Bool
+isOff :: Pixel X Bit -> Bool
 isOff = not . isOn
 {-# INLINE isOff #-}
 
 
-
-instance ColorSpace Binary Bit where
-  type Components Binary Bit = Bit
-
-  promote = PixelBinary
-  {-# INLINE promote #-}
-  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 #-}
-  liftPx f (PixelBinary b) = PixelBinary (f b)
-  {-# INLINE liftPx #-}
-  liftPx2 f (PixelBinary b1) (PixelBinary b2) = PixelBinary (f b1 b2)
-  {-# INLINE liftPx2 #-}
-  foldrPx f z (PixelBinary b) = f b z
-  {-# INLINE foldrPx #-}
-  foldlPx2 f !z (PixelBinary b1) (PixelBinary b2) = f z b1 b2
-  {-# INLINE foldlPx2 #-}
-
 -- | Values: @0@ and @1@
 instance Elevator Bit where
   toWord8 (Bit 0) = 0
@@ -221,22 +205,19 @@
   fromDouble _ = Bit 1
   {-# INLINE fromDouble #-}
 
-  
 
 instance Num Bit where
-  (Bit 0) + (Bit 0) = Bit 0
-  _       + _       = Bit 1
+  (+) = (.|.)
   {-# INLINE (+) #-}
   -- 0 - 0 = 0
   -- 0 - 1 = 0
   -- 1 - 0 = 1
   -- 1 - 1 = 0
-  _ - (Bit 1) = Bit 0
-  _ - _       = Bit 1
+  (Bit 0) - (Bit 0) = Bit 0
+  _       - (Bit 0) = Bit 1
+  _       - _       = Bit 0
   {-# INLINE (-) #-}
-  _       * (Bit 0) = Bit 0
-  (Bit 0) * _       = Bit 0
-  _       * _       = Bit 1
+  (*) = (.&.)
   {-# INLINE (*) #-}
   abs         = id
   {-# INLINE abs #-}
@@ -250,28 +231,18 @@
 instance Storable Bit where
 
   sizeOf _ = sizeOf (undefined :: Word8)
+  {-# INLINE sizeOf #-}
   alignment _ = alignment (undefined :: Word8)
-  peek p = do
+  {-# INLINE alignment #-}
+  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
+  {-# INLINE peek #-}
+  poke !p (Bit b) = do
     q <- return $ castPtr p
     poke q b
-
+  {-# INLINE poke #-}
 
 
 -- | Unboxing of a `Bit`.
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
@@ -1,10 +1,10 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE BangPatterns          #-}
+{-# LANGUAGE DeriveDataTypeable    #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeFamilies          #-}
 -- |
 -- Module      : Graphics.Image.ColorSpace.CMYK
 -- Copyright   : (c) Alexey Kuleshevich 2017
@@ -17,13 +17,13 @@
   CMYK(..), CMYKA(..), Pixel(..)
   ) where
 
-import Prelude hiding (map)
-import Control.Applicative
-import Data.Foldable
-import Data.Typeable (Typeable)
-import Foreign.Ptr
-import Foreign.Storable
-import Graphics.Image.Interface
+import           Control.Applicative
+import           Data.Foldable
+import           Data.Typeable            (Typeable)
+import           Foreign.Ptr
+import           Foreign.Storable
+import           Graphics.Image.Interface
+import           Prelude                  hiding (map)
 
 ------------
 --- CMYK ---
@@ -45,7 +45,7 @@
 
 instance Elevator 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)
@@ -97,20 +97,24 @@
 instance Storable e => Storable (Pixel CMYK e) where
 
   sizeOf _ = 4 * sizeOf (undefined :: e)
+  {-# INLINE sizeOf #-}
   alignment _ = alignment (undefined :: e)
-  peek p = do
+  {-# INLINE alignment #-}
+  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
+  {-# INLINE peek #-}
+  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
+  {-# INLINE poke #-}
 
 -------------
 --- CMYKA ---
@@ -121,7 +125,7 @@
            | MagCMYKA   -- ^ Magenta
            | YelCMYKA   -- ^ Yellow
            | KeyCMYKA   -- ^ Key (Black)
-           | AlphaCMYKA -- ^ Alpha 
+           | AlphaCMYKA -- ^ Alpha
            deriving (Eq, Enum, Show, Bounded, Typeable)
 
 
@@ -135,7 +139,7 @@
 
 instance Elevator e => ColorSpace CMYKA e where
   type Components CMYKA e = (e, e, e, e, e)
-  
+
   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)
@@ -173,7 +177,7 @@
 
   getAlpha (PixelCMYKA _ _ _ _ a) = a
   {-# INLINE getAlpha #-}
-  
+
   addAlpha !a (PixelCMYK c m y k) = PixelCMYKA c m y k a
   {-# INLINE addAlpha #-}
 
@@ -202,8 +206,10 @@
 instance Storable e => Storable (Pixel CMYKA e) where
 
   sizeOf _ = 5 * sizeOf (undefined :: e)
+  {-# INLINE sizeOf #-}
   alignment _ = alignment (undefined :: e)
-  peek p = do
+  {-# INLINE alignment #-}
+  peek !p = do
     q <- return $ castPtr p
     c <- peek q
     m <- peekElemOff q 1
@@ -211,10 +217,12 @@
     k <- peekElemOff q 3
     a <- peekElemOff q 4
     return (PixelCMYKA c m y k a)
-  poke p (PixelCMYKA c m y k a) = do
+  {-# INLINE peek #-}
+  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
+  {-# INLINE poke #-}
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
@@ -1,10 +1,10 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE BangPatterns          #-}
+{-# LANGUAGE DeriveDataTypeable    #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeFamilies          #-}
 -- |
 -- Module      : Graphics.Image.ColorSpace.HSI
 -- Copyright   : (c) Alexey Kuleshevich 2017
@@ -17,13 +17,13 @@
   HSI(..), HSIA(..), Pixel(..)
   ) where
 
-import Prelude hiding (map)
-import Control.Applicative
-import Data.Foldable
-import Data.Typeable (Typeable)
-import Foreign.Ptr
-import Foreign.Storable
-import Graphics.Image.Interface
+import           Control.Applicative
+import           Data.Foldable
+import           Data.Typeable            (Typeable)
+import           Foreign.Ptr
+import           Foreign.Storable
+import           Graphics.Image.Interface
+import           Prelude                  hiding (map)
 
 -----------
 --- HSI ---
@@ -31,7 +31,7 @@
 
 -- | Hue, Saturation and Intensity color space.
 data HSI = HueHSI -- ^ Hue
-         | SatHSI -- ^ Saturation 
+         | SatHSI -- ^ Saturation
          | IntHSI -- ^ Intensity
          deriving (Eq, Enum, Show, Bounded, Typeable)
 
@@ -92,18 +92,22 @@
 instance Storable e => Storable (Pixel HSI e) where
 
   sizeOf _ = 3 * sizeOf (undefined :: e)
+  {-# INLINE sizeOf #-}
   alignment _ = alignment (undefined :: e)
-  peek p = do
+  {-# INLINE alignment #-}
+  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
+  {-# INLINE peek #-}
+  poke !p (PixelHSI r g b) = do
     q <- return $ castPtr p
     poke q r
     pokeElemOff q 1 g
     pokeElemOff q 2 b
+  {-# INLINE poke #-}
 
 ------------
 --- HSIA ---
@@ -187,17 +191,21 @@
 
 instance Storable e => Storable (Pixel HSIA e) where
   sizeOf _ = 4 * sizeOf (undefined :: e)
+  {-# INLINE sizeOf #-}
   alignment _ = alignment (undefined :: e)
-  peek p = do
+  {-# INLINE alignment #-}
+  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
+  {-# INLINE peek #-}
+  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
+  {-# INLINE poke #-}
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
@@ -180,7 +180,7 @@
   foldr f !z (PixelRGBA r g b a) = f r (f g (f b (f a z)))
   {-# INLINE foldr #-}
 
- 
+
 instance Storable e => Storable (Pixel RGBA e) where
   sizeOf _ = 4 * sizeOf (undefined :: e)
   alignment _ = alignment (undefined :: e)
diff --git a/src/Graphics/Image/ColorSpace/X.hs b/src/Graphics/Image/ColorSpace/X.hs
--- a/src/Graphics/Image/ColorSpace/X.hs
+++ b/src/Graphics/Image/ColorSpace/X.hs
@@ -1,10 +1,10 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE BangPatterns          #-}
+{-# LANGUAGE DeriveDataTypeable    #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeFamilies          #-}
 -- |
 -- Module      : Graphics.Image.ColorSpace.X
 -- Copyright   : (c) Alexey Kuleshevich 2017
@@ -16,16 +16,18 @@
 module Graphics.Image.ColorSpace.X (
   X(..), Pixel(..),
   toPixelsX, toImagesX,
-  fromPixelsX, fromImagesX
+  fromPixelsX, fromImagesX,
+  squashWith, squashWith2
   ) where
 
-import Prelude as P
-import Control.Applicative
-import Data.Foldable
-import Data.Typeable (Typeable)
-import Foreign.Ptr
-import Foreign.Storable
-import Graphics.Image.Interface as I
+import           Control.Applicative
+import           Data.Foldable
+import           Data.Typeable            (Typeable)
+import           Foreign.Ptr
+import           Foreign.Storable
+import           Graphics.Image.Interface as I
+import           Prelude                  as P
+import           Graphics.Image.Utils ((.:!))
 
 -- ^ 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
@@ -35,7 +37,7 @@
 data X = X deriving (Eq, Enum, Bounded, Show, Typeable)
 
 
-newtype instance Pixel X e = PixelX e deriving (Ord, Eq)
+newtype instance Pixel X e = PixelX { getX :: e } deriving (Ord, Eq)
 
 
 instance Show e => Show (Pixel X e) where
@@ -96,14 +98,18 @@
 instance Storable e => Storable (Pixel X e) where
 
   sizeOf _ = sizeOf (undefined :: e)
+  {-# INLINE sizeOf #-}
   alignment _ = alignment (undefined :: e)
-  peek p = do
+  {-# INLINE alignment #-}
+  peek !p = do
     q <- return $ castPtr p
     g <- peek q
     return (PixelX g)
-  poke p (PixelX g) = do
+  {-# INLINE peek #-}
+  poke !p (PixelX g) = do
     q <- return $ castPtr p
     poke q g
+  {-# INLINE poke #-}
 
 
 -- | Separate a Pixel into a list of components with 'X' pixels containing every
@@ -129,6 +135,21 @@
   f !px (c, PixelX x) = setPxC px c x
 
 
+
+-- | Apply a left fold to each of the pixels in the image.
+squashWith :: (Array arr cs e, Array arr X b) =>
+              (b -> e -> b) -> b -> Image arr cs e -> Image arr X b
+squashWith f !a = I.map (PixelX . foldlPx f a) where
+{-# INLINE squashWith #-}
+
+
+-- | Combination of zipWith and simultanious left fold on two pixels at the same time.
+squashWith2 :: (Array arr cs e, Array arr X b) =>
+               (b -> e -> e -> b) -> b -> Image arr cs e -> Image arr cs e -> Image arr X b
+squashWith2 f !a = I.zipWith (PixelX .:! foldlPx2 f a) where
+{-# INLINE squashWith2 #-}
+
+
 -- | Separate an image into a list of images with 'X' pixels containing every
 -- channel from the source image.
 --
@@ -167,7 +188,7 @@
 fromImagesX = fromXs 0 where
   updateCh !ch !px (PixelX e) = setPxC px ch e
   {-# INLINE updateCh #-}
-  fromXs img []      = img
+  fromXs img []          = img
   fromXs img ((c, i):xs) = fromXs (I.zipWith (updateCh c) img i) xs
   {-# INLINE fromXs #-}
 {-# INLINE fromImagesX #-}
diff --git a/src/Graphics/Image/ColorSpace/Y.hs b/src/Graphics/Image/ColorSpace/Y.hs
--- a/src/Graphics/Image/ColorSpace/Y.hs
+++ b/src/Graphics/Image/ColorSpace/Y.hs
@@ -1,10 +1,10 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE BangPatterns          #-}
+{-# LANGUAGE DeriveDataTypeable    #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeFamilies          #-}
 -- |
 -- Module      : Graphics.Image.ColorSpace.Y
 -- Copyright   : (c) Alexey Kuleshevich 2017
@@ -17,13 +17,13 @@
   Y(..), YA(..), Pixel(..)
   ) where
 
-import Prelude hiding (map)
-import Control.Applicative
-import Data.Foldable
-import Data.Typeable (Typeable)
-import Foreign.Ptr
-import Foreign.Storable
-import Graphics.Image.Interface
+import           Control.Applicative
+import           Data.Foldable
+import           Data.Typeable            (Typeable)
+import           Foreign.Ptr
+import           Foreign.Storable
+import           Graphics.Image.Interface
+import           Prelude                  hiding (map)
 
 ---------
 --- Y ---
@@ -92,14 +92,16 @@
 instance Storable e => Storable (Pixel Y e) where
 
   sizeOf _ = sizeOf (undefined :: e)
+  {-# INLINE sizeOf #-}
   alignment _ = alignment (undefined :: e)
-  peek p = do
-    q <- return $ castPtr p
+  {-# INLINE alignment #-}
+  peek !p = do
+    let !q = castPtr p
     y <- peek q
     return (PixelY y)
-  poke p (PixelY y) = do
-    q <- return $ castPtr p
-    poke q y
+  {-# INLINE peek #-}
+  poke !p (PixelY y) = let !q = castPtr p in poke q y
+  {-# INLINE poke #-}
 
 
 
@@ -145,7 +147,7 @@
   foldlPx2 f !z (PixelYA y1 a1) (PixelYA y2 a2) = f (f z y1 y2) a1 a2
   {-# INLINE foldlPx2 #-}
 
-  
+
 instance Elevator e => AlphaSpace YA e where
   type Opaque YA = Y
 
@@ -156,7 +158,7 @@
   dropAlpha (PixelYA y _) = PixelY y
   {-# INLINE dropAlpha #-}
 
-  
+
 instance Functor (Pixel YA) where
   fmap f (PixelYA y a) = PixelYA (f y) (f a)
   {-# INLINE fmap #-}
@@ -177,14 +179,18 @@
 instance Storable e => Storable (Pixel YA e) where
 
   sizeOf _ = 2 * sizeOf (undefined :: e)
+  {-# INLINE sizeOf #-}
   alignment _ = alignment (undefined :: e)
-  peek p = do
+  {-# INLINE alignment #-}
+  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
+  {-# INLINE peek #-}
+  poke !p (PixelYA y a) = do
     q <- return $ castPtr p
     pokeElemOff q 0 y
     pokeElemOff q 1 a
+  {-# INLINE poke #-}
 
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
@@ -1,10 +1,10 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE BangPatterns          #-}
+{-# LANGUAGE DeriveDataTypeable    #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeFamilies          #-}
 -- |
 -- Module      : Graphics.Image.ColorSpace.YCbCr
 -- Copyright   : (c) Alexey Kuleshevich 2017
@@ -17,13 +17,13 @@
   YCbCr(..), YCbCrA(..), Pixel(..)
   ) where
 
-import Prelude hiding (map)
-import Control.Applicative
-import Data.Foldable
-import Data.Typeable (Typeable)
-import Foreign.Ptr
-import Foreign.Storable
-import Graphics.Image.Interface
+import           Control.Applicative
+import           Data.Foldable
+import           Data.Typeable            (Typeable)
+import           Foreign.Ptr
+import           Foreign.Storable
+import           Graphics.Image.Interface
+import           Prelude                  hiding (map)
 
 -------------
 --- YCbCr ---
@@ -38,7 +38,7 @@
 
 data instance Pixel YCbCr e = PixelYCbCr !e !e !e deriving Eq
 
-  
+
 instance Show e => Show (Pixel YCbCr e) where
   show (PixelYCbCr y b r) = "<YCbCr:("++show y++"|"++show b++"|"++show r++")>"
 
@@ -93,18 +93,22 @@
 instance Storable e => Storable (Pixel YCbCr e) where
 
   sizeOf _ = 3 * sizeOf (undefined :: e)
+  {-# INLINE sizeOf #-}
   alignment _ = alignment (undefined :: e)
-  peek p = do
+  {-# INLINE alignment #-}
+  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
+  {-# INLINE poke #-}
+  poke !p (PixelYCbCr y b r) = do
     q <- return $ castPtr p
     pokeElemOff q 0 y
     pokeElemOff q 1 b
     pokeElemOff q 2 r
+  {-# INLINE peek #-}
 
 
 --------------
@@ -190,19 +194,23 @@
 instance Storable e => Storable (Pixel YCbCrA e) where
 
   sizeOf _ = 4 * sizeOf (undefined :: e)
+  {-# INLINE sizeOf #-}
   alignment _ = alignment (undefined :: e)
-  peek p = do
+  {-# INLINE alignment #-}
+  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
+  {-# INLINE peek #-}
+  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
+  {-# INLINE poke #-}
 
 
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
@@ -29,7 +29,7 @@
   gimpViewer,
   -- * Supported Image Formats
   module Graphics.Image.IO.Formats
-  
+
   -- $supported
 
   -- * Hands on examples
@@ -64,7 +64,7 @@
 data ExternalViewer =
   ExternalViewer FilePath [String] Int
     -- ^ Any custom viewer, which can be specified:
-    -- 
+    --
     -- * @FilePath@ - to the actual viewer executable.
     -- * @[String]@ - command line arguments that will be passed to the executable.
     -- * @Int@ - position index in the above list where `FilePath` to an image should be
@@ -99,7 +99,7 @@
       formats = enumFrom . toEnum $ 0
       orderedFormats = maybe formats (\f -> f:P.filter (/=f) formats) maybeFormat
       reader :: Either String (Image VS cs e) -> InputFormat -> IO (Either String (Image VS cs e))
-      reader (Left err) format = 
+      reader (Left err) format =
         return $ either (Left . ((err++"\n")++)) Right (decode format imgstr)
       reader img         _     = return img
   imgE <- M.foldM reader (Left "") orderedFormats
@@ -161,7 +161,7 @@
 writeImage :: (Array VS cs e, Array arr cs e,
                Writable (Image VS cs e) OutputFormat) =>
               FilePath            -- ^ Location where an image should be written.
-           -> Image arr cs e -- ^ An image to write. 
+           -> Image arr cs e -- ^ An image to write.
            -> IO ()
 writeImage path = BL.writeFile path . encode format [] . exchange VS where
   format = fromMaybe (error ("Could not guess output format. Use 'writeImageExact' "++
@@ -183,8 +183,8 @@
                        -- 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.
 displayImageUsing :: (Array VS cs e, Array arr cs e,
@@ -271,11 +271,11 @@
 Encoding and decoding of images is done using
 <http://hackage.haskell.org/package/JuicyPixels JuicyPixels> and
 <http://hackage.haskell.org/package/netpbm netpbm> packages.
-   
+
 List of image formats that are currently supported, and their exact
 'ColorSpace's and precision for reading and writing without an implicit
 conversion:
-  
+
 * 'BMP':
 
     * __read__: ('Y' 'Word8'), ('RGB' 'Word8'), ('RGBA' 'Word8')
diff --git a/src/Graphics/Image/IO/Base.hs b/src/Graphics/Image/IO/Base.hs
--- a/src/Graphics/Image/IO/Base.hs
+++ b/src/Graphics/Image/IO/Base.hs
@@ -1,7 +1,9 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE BangPatterns          #-}
+{-# LANGUAGE ConstraintKinds       #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeFamilies          #-}
 -- |
 -- Module      : Graphics.Image.IO.Base
 -- Copyright   : (c) Alexey Kuleshevich 2016
@@ -11,35 +13,37 @@
 -- Portability : non-portable
 --
 module Graphics.Image.IO.Base (
-  ImageFormat(..), Readable(..), Writable(..), Convertible(..),
+  ImageFormat(..), Readable(..), Writable(..), Convertible(..), Seq(..), ComplexWritable
   ) where
 
-import qualified Data.ByteString as B (ByteString)
-import qualified Data.ByteString.Lazy as BL (ByteString)
-
-import Graphics.Image.ColorSpace
+import qualified Data.ByteString                     as B (ByteString)
+import qualified Data.ByteString.Lazy                as BL (ByteString)
+import           Graphics.Image.ColorSpace
+import           Graphics.Image.Interface            as I
+import           Graphics.Image.Processing.Complex   (imagPartI, realPartI)
+import           Graphics.Image.Processing.Geometric (leftToRight)
 
 -- | Used during converting pixels between libraries.
-class Convertible a b where
-  convert :: a -> b
+class Convertible cs e where
+  convert :: (ToYA cs' e', ToRGBA cs' e', Array arr cs' e', Array arr cs e) =>
+    Image arr cs' e' -> Image arr cs e
 
---  Y (Double)
 
-instance ToY cs e => Convertible (Pixel cs e) (Pixel Y Double) where
-  convert = toPixelY
-
-instance ToYA cs e => Convertible (Pixel cs e) (Pixel YA Double) where
-  convert = toPixelYA
+instance Convertible Y Double where
+  convert = toImageY
 
--- RGB -> RGB (Double)
+instance Convertible YA Double where
+  convert = toImageYA
 
-instance ToRGB cs e => Convertible (Pixel cs e) (Pixel RGB Double) where
-  convert = toPixelRGB
+instance Convertible RGB Double where
+  convert = toImageRGB
 
-instance ToRGBA cs e => Convertible (Pixel cs e) (Pixel RGBA Double) where
-  convert = toPixelRGBA
+instance Convertible RGBA Double where
+  convert = toImageRGBA
 
 
+-- | Special wrapper for formats that support encoding/decoding sequence of images.
+newtype Seq f = Seq f
 
 -- | Image file format. Helps in guessing image format using a file extension,
 -- as well as supplying format specific options during saving an image.
@@ -50,11 +54,13 @@
   -- | Default file extension for this image format.
   ext :: format -> String
 
-  -- | Known extensions for this image format.
+  -- | Known file extensions for this image format, if more than one is commonly
+  -- used, eg. ".jpeg", ".jpg".
   exts :: format -> [String]
   exts f = [ext f]
 
-  -- | Returns `True` if a file extension (ex. @".png"@) corresponds to this format.
+  -- | Checks if a file extension
+  -- corresponds to the format, eg. @isFormat ".png" PNG == True@
   isFormat :: String -> format -> Bool
   isFormat e f = e `elem` exts f
 
@@ -69,5 +75,16 @@
 -- | Image formats that can be written to file.
 class ImageFormat format => Writable img format where
 
-  -- | Encode an image to `BL.ByteString`.
+  -- | Encode an image into `BL.ByteString`.
   encode :: format -> [SaveOption format] -> img -> BL.ByteString
+
+-- | Constraint type synonym for encoding a Complex image.
+type ComplexWritable format arr cs e = ( Array arr cs e, Array arr cs (Complex e)
+                                       , RealFloat e, Applicative (Pixel cs)
+                                       , Writable (Image arr cs e) format )
+
+
+-- | Writing Complex images: places real part on the left side of imaginary part.
+instance ComplexWritable format arr cs e => Writable (Image arr cs (Complex e)) format where
+  encode format opts !imgC =
+    encode format opts (leftToRight (realPartI imgC) (imagPartI imgC))
diff --git a/src/Graphics/Image/IO/Formats.hs b/src/Graphics/Image/IO/Formats.hs
--- a/src/Graphics/Image/IO/Formats.hs
+++ b/src/Graphics/Image/IO/Formats.hs
@@ -1,9 +1,10 @@
+{-# LANGUAGE ConstraintKinds       #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE UndecidableInstances  #-}
 -- |
 -- Module      : Graphics.Image.IO.Formats
 -- Copyright   : (c) Alexey Kuleshevich 2017
@@ -12,25 +13,31 @@
 -- Stability   : experimental
 -- Portability : non-portable
 --
-module Graphics.Image.IO.Formats (
-  module Graphics.Image.IO.Formats.JuicyPixels.Common,
-  module Graphics.Image.IO.Formats.Netpbm,
-  InputFormat(..), OutputFormat(..),
-  Readable(..), Writable(..), ImageFormat(..),
-  Convertible(..)
+module Graphics.Image.IO.Formats
+  ( module Graphics.Image.IO.Formats.JuicyPixels
+  , module Graphics.Image.IO.Formats.Netpbm
+    -- * General
+  , ImageFormat(..)
+  , InputFormat(..)
+  , OutputFormat(..)
+  , Readable(..)
+  , Writable(..)
+  , Convertible(..)
+  , Seq(..)
+  , AllReadable
+  , AllWritable
+  , ComplexWritable
   ) where
 
-import Graphics.Image.ColorSpace
-import Graphics.Image.Interface
-import Graphics.Image.Processing
-import Graphics.Image.Processing.Complex
-import Graphics.Image.IO.Base
-import Graphics.Image.IO.Formats.JuicyPixels.Common
-import Graphics.Image.IO.Formats.JuicyPixels.Readable()
-import Graphics.Image.IO.Formats.JuicyPixels.Writable()
-import Graphics.Image.IO.Formats.Netpbm
 
+import           Graphics.Image.Interface
+import           Graphics.Image.IO.Base
+import           Graphics.Image.IO.Formats.JuicyPixels
+import           Graphics.Image.IO.Formats.Netpbm
 
+
+
+
 -- | A collection of all image formats that can be read into HIP images.
 data InputFormat = InputBMP
                  | InputGIF
@@ -64,15 +71,18 @@
   exts InputPNM = [ext PBM, ext PGM, ext PPM]
 
 
-instance (Readable (Image arr cs Double) BMP,
-          Readable (Image arr cs Double) GIF,
-          Readable (Image arr cs Double) HDR,
-          Readable (Image arr cs Double) JPG,
-          Readable (Image arr cs Double) PNG,
-          Readable (Image arr cs Double) TGA,
-          Readable (Image arr cs Double) TIF,
-          Readable (Image arr cs Double) PPM) =>
-         Readable (Image arr cs Double) InputFormat where
+-- | Constraint type synonym for all readable formats.
+type AllReadable arr cs = ( Readable (Image arr cs Double) BMP
+                          , Readable (Image arr cs Double) GIF
+                          , Readable (Image arr cs Double) HDR
+                          , Readable (Image arr cs Double) JPG
+                          , Readable (Image arr cs Double) PNG
+                          , Readable (Image arr cs Double) TGA
+                          , Readable (Image arr cs Double) TIF
+                          , Readable (Image arr cs Double) PPM )
+
+
+instance AllReadable arr cs => Readable (Image arr cs Double) InputFormat where
   decode InputBMP = decode BMP
   decode InputGIF = decode GIF
   decode InputHDR = decode HDR
@@ -105,15 +115,26 @@
   ext OutputTGA = ext TGA
   ext OutputTIF = ext TIF
 
+  exts OutputBMP = exts BMP
+  exts OutputGIF = exts GIF
+  exts OutputHDR = exts HDR
+  exts OutputJPG = exts JPG
+  exts OutputPNG = exts PNG
+  exts OutputTGA = exts TGA
+  exts OutputTIF = exts TIF
 
-instance (Writable (Image arr cs Double) BMP,
-          Writable (Image arr cs Double) GIF,
-          Writable (Image arr cs Double) HDR,
-          Writable (Image arr cs Double) JPG,
-          Writable (Image arr cs Double) PNG,
-          Writable (Image arr cs Double) TGA,
-          Writable (Image arr cs Double) TIF) =>
-         Writable (Image arr cs Double) OutputFormat where
+
+-- | Constraint type synonym for all writable formats.
+type AllWritable arr cs = ( Writable (Image arr cs Double) BMP
+                          , Writable (Image arr cs Double) GIF
+                          , Writable (Image arr cs Double) HDR
+                          , Writable (Image arr cs Double) JPG
+                          , Writable (Image arr cs Double) PNG
+                          , Writable (Image arr cs Double) TGA
+                          , Writable (Image arr cs Double) TIF )
+
+
+instance AllWritable arr cs => Writable (Image arr cs Double) OutputFormat where
   encode OutputBMP _ = encode BMP []
   encode OutputGIF _ = encode GIF []
   encode OutputHDR _ = encode HDR []
@@ -121,11 +142,3 @@
   encode OutputPNG _ = encode PNG []
   encode OutputTGA _ = encode TGA []
   encode OutputTIF _ = encode TIF []
-
-
-instance (Array arr cs e, Array arr cs (Complex e),
-          RealFloat e, Applicative (Pixel cs),
-          Writable (Image arr cs e) format) =>
-         Writable (Image arr cs (Complex e)) format where
-  encode format opts imgC =
-    encode format opts (leftToRight (realPartI imgC) (imagPartI imgC))
diff --git a/src/Graphics/Image/IO/Formats/JuicyPixels.hs b/src/Graphics/Image/IO/Formats/JuicyPixels.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/Image/IO/Formats/JuicyPixels.hs
@@ -0,0 +1,1034 @@
+{-# LANGUAGE BangPatterns          #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE TypeSynonymInstances  #-}
+-- |
+-- Module      : Graphics.Image.IO.Formats.JuicyPixels
+-- Copyright   : (c) Alexey Kuleshevich 2017
+-- License     : BSD3
+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
+-- Stability   : experimental
+-- Portability : non-portable
+--
+module Graphics.Image.IO.Formats.JuicyPixels
+  ( -- * JuicyPixels formats
+    SaveOption(..)
+    -- ** BMP
+  , BMP(..)
+    -- ** GIF
+  , GIF(..)
+  , GIFA(..)
+  , JP.GifDelay
+  , JP.GifLooping(..)
+  , JP.PaletteOptions(..)
+  , JP.PaletteCreationMethod(..)
+  -- ** HDR
+  , HDR(..)
+  -- ** JPG
+  , JPG(..)
+  -- ** PNG
+  , PNG(..)
+  -- ** TGA
+  , TGA(..)
+  -- ** TIF
+  , TIF(..)
+  -- * JuciyPixels conversion
+  -- ** To JuicyPixels
+  -- O(1) Conversion to JuicyPixels images
+  , toJPImageY8
+  , toJPImageYA8
+  , toJPImageY16
+  , toJPImageYA16
+  , toJPImageYF
+  , toJPImageRGB8
+  , toJPImageRGBA8
+  , toJPImageRGB16
+  , toJPImageRGBA16
+  , toJPImageRGBF
+  , toJPImageYCbCr8
+  , toJPImageCMYK8
+  , toJPImageCMYK16
+  -- ** From JuicyPixels
+  -- O(1) Conversion from JuicyPixels images
+  , fromJPImageY8
+  , fromJPImageYA8
+  , fromJPImageY16
+  , fromJPImageYA16
+  , fromJPImageYF
+  , fromJPImageRGB8
+  , fromJPImageRGBA8
+  , fromJPImageRGB16
+  , fromJPImageRGBA16
+  , fromJPImageRGBF
+  , fromJPImageYCbCr8
+  , fromJPImageCMYK8
+  , fromJPImageCMYK16
+  ) where
+
+import           Prelude                         as P
+
+import qualified Codec.Picture                   as JP
+import qualified Codec.Picture.ColorQuant        as JP
+import qualified Codec.Picture.Gif               as JP
+import qualified Codec.Picture.Jpg               as JP
+import           Control.Monad                   ((<=<))
+import qualified Data.ByteString                 as B (ByteString)
+import qualified Data.ByteString.Lazy            as BL (ByteString)
+import qualified Data.Monoid                     as M (mempty)
+import qualified Data.Vector.Storable            as V
+import           Graphics.Image.ColorSpace
+import           Graphics.Image.Interface        as I
+import           Graphics.Image.Interface.Vector (VS)
+import           Graphics.Image.IO.Base
+
+
+
+
+-- Encoding
+
+imageToJPImageUnsafe
+  :: (JP.Pixel a, Array VS cs (JP.PixelBaseComponent a))
+  => Image VS cs (JP.PixelBaseComponent a)
+  -> JP.Image a
+imageToJPImageUnsafe img = JP.Image n m $ V.unsafeCast $ toVector img where
+  (m, n) = dims img
+{-# INLINE imageToJPImageUnsafe #-}
+
+toJPImageY8 :: Image VS Y Word8 -> JP.Image JP.Pixel8
+toJPImageY8 = imageToJPImageUnsafe
+{-# INLINE toJPImageY8 #-}
+
+toJPImageY16 :: Image VS Y Word16 -> JP.Image JP.Pixel16
+toJPImageY16 = imageToJPImageUnsafe
+{-# INLINE toJPImageY16 #-}
+
+toJPImageYA8 :: Image VS YA Word8 -> JP.Image JP.PixelYA8
+toJPImageYA8 = imageToJPImageUnsafe
+{-# INLINE toJPImageYA8 #-}
+
+toJPImageYA16 :: Image VS YA Word16 -> JP.Image JP.PixelYA16
+toJPImageYA16 = imageToJPImageUnsafe
+{-# INLINE toJPImageYA16 #-}
+
+toJPImageYF :: Image VS Y Float -> JP.Image JP.PixelF
+toJPImageYF = imageToJPImageUnsafe
+{-# INLINE toJPImageYF #-}
+
+toJPImageRGB8 :: Image VS RGB Word8 -> JP.Image JP.PixelRGB8
+toJPImageRGB8 = imageToJPImageUnsafe
+{-# INLINE toJPImageRGB8 #-}
+
+toJPImageRGBA8 :: Image VS RGBA Word8 -> JP.Image JP.PixelRGBA8
+toJPImageRGBA8 = imageToJPImageUnsafe
+{-# INLINE toJPImageRGBA8 #-}
+
+toJPImageRGB16 :: Image VS RGB Word16 -> JP.Image JP.PixelRGB16
+toJPImageRGB16 = imageToJPImageUnsafe
+{-# INLINE toJPImageRGB16 #-}
+
+toJPImageRGBA16 :: Image VS RGBA Word16 -> JP.Image JP.PixelRGBA16
+toJPImageRGBA16 = imageToJPImageUnsafe
+{-# INLINE toJPImageRGBA16 #-}
+
+toJPImageRGBF :: Image VS RGB Float -> JP.Image JP.PixelRGBF
+toJPImageRGBF = imageToJPImageUnsafe
+{-# INLINE toJPImageRGBF #-}
+
+toJPImageYCbCr8 :: Image VS YCbCr Word8 -> JP.Image JP.PixelYCbCr8
+toJPImageYCbCr8 = imageToJPImageUnsafe
+{-# INLINE toJPImageYCbCr8 #-}
+
+toJPImageCMYK8 :: Image VS CMYK Word8 -> JP.Image JP.PixelCMYK8
+toJPImageCMYK8 = imageToJPImageUnsafe
+{-# INLINE toJPImageCMYK8 #-}
+
+toJPImageCMYK16 :: Image VS CMYK Word16 -> JP.Image JP.PixelCMYK16
+toJPImageCMYK16 = imageToJPImageUnsafe
+{-# INLINE toJPImageCMYK16 #-}
+
+
+
+
+-- General decoding and helper functions
+
+
+jpImageToImageUnsafe :: (Array VS cs e, JP.Pixel jpx) =>
+                        JP.Image jpx -> Image VS cs e
+jpImageToImageUnsafe (JP.Image n m !v) = fromVector (m, n) $ V.unsafeCast v
+{-# INLINE jpImageToImageUnsafe #-}
+
+
+fromJPImageY8 :: JP.Image JP.Pixel8 -> Image VS Y Word8
+fromJPImageY8 = jpImageToImageUnsafe
+{-# INLINE fromJPImageY8 #-}
+
+fromJPImageY16 :: JP.Image JP.Pixel16 -> Image VS Y Word16
+fromJPImageY16 = jpImageToImageUnsafe
+{-# INLINE fromJPImageY16 #-}
+
+fromJPImageYA8 :: JP.Image JP.PixelYA8 -> Image VS YA Word8
+fromJPImageYA8 = jpImageToImageUnsafe
+{-# INLINE fromJPImageYA8 #-}
+
+fromJPImageYA16 :: JP.Image JP.PixelYA16 -> Image VS YA Word16
+fromJPImageYA16 = jpImageToImageUnsafe
+{-# INLINE fromJPImageYA16 #-}
+
+fromJPImageRGB8 :: JP.Image JP.PixelRGB8 -> Image VS RGB Word8
+fromJPImageRGB8 = jpImageToImageUnsafe
+{-# INLINE fromJPImageRGB8 #-}
+
+fromJPImageYF :: JP.Image JP.PixelF -> Image VS Y Float
+fromJPImageYF = jpImageToImageUnsafe
+{-# INLINE fromJPImageYF #-}
+
+fromJPImageRGBA8 :: JP.Image JP.PixelRGBA8 -> Image VS RGBA Word8
+fromJPImageRGBA8 = jpImageToImageUnsafe
+{-# INLINE fromJPImageRGBA8 #-}
+
+fromJPImageRGB16 :: JP.Image JP.PixelRGB16 -> Image VS RGB Word16
+fromJPImageRGB16 = jpImageToImageUnsafe
+{-# INLINE fromJPImageRGB16 #-}
+
+fromJPImageRGBA16 :: JP.Image JP.PixelRGBA16 -> Image VS RGBA Word16
+fromJPImageRGBA16 = jpImageToImageUnsafe
+{-# INLINE fromJPImageRGBA16 #-}
+
+fromJPImageRGBF :: JP.Image JP.PixelRGBF -> Image VS RGB Float
+fromJPImageRGBF = jpImageToImageUnsafe
+{-# INLINE fromJPImageRGBF #-}
+
+fromJPImageYCbCr8 :: JP.Image JP.PixelYCbCr8 -> Image VS YCbCr Word8
+fromJPImageYCbCr8 = jpImageToImageUnsafe
+{-# INLINE fromJPImageYCbCr8 #-}
+
+fromJPImageCMYK8 :: JP.Image JP.PixelCMYK8 -> Image VS CMYK Word8
+fromJPImageCMYK8 = jpImageToImageUnsafe
+{-# INLINE fromJPImageCMYK8 #-}
+
+fromJPImageCMYK16 :: JP.Image JP.PixelCMYK16 -> Image VS CMYK Word16
+fromJPImageCMYK16 = jpImageToImageUnsafe
+{-# INLINE fromJPImageCMYK16 #-}
+
+
+jpImageY8ToImage :: JP.DynamicImage -> Either String (Image VS Y Word8)
+jpImageY8ToImage (JP.ImageY8 jimg) = Right (fromJPImageY8 jimg)
+jpImageY8ToImage jimg              = jpCSError "Y8 (Pixel Y Word8)" jimg
+{-# INLINE jpImageY8ToImage #-}
+
+jpImageY16ToImage :: JP.DynamicImage -> Either String (Image VS Y Word16)
+jpImageY16ToImage (JP.ImageY16 jimg) = Right (fromJPImageY16 jimg)
+jpImageY16ToImage jimg               = jpCSError "Y16 (Pixel Y Word16)" jimg
+{-# INLINE jpImageY16ToImage #-}
+
+jpImageYA8ToImage :: JP.DynamicImage -> Either String (Image VS YA Word8)
+jpImageYA8ToImage (JP.ImageYA8 jimg) = Right (fromJPImageYA8 jimg)
+jpImageYA8ToImage jimg               = jpCSError "YA8 (Pixel YA Word8)" jimg
+{-# INLINE jpImageYA8ToImage #-}
+
+jpImageYA16ToImage :: JP.DynamicImage -> Either String (Image VS YA Word16)
+jpImageYA16ToImage (JP.ImageYA16 jimg) = Right (fromJPImageYA16 jimg)
+jpImageYA16ToImage jimg = jpCSError "YA16 (Pixel YA Word16)" jimg
+{-# INLINE jpImageYA16ToImage #-}
+
+jpImageRGB8ToImage :: JP.DynamicImage -> Either String (Image VS RGB Word8)
+jpImageRGB8ToImage (JP.ImageRGB8 jimg) = Right (fromJPImageRGB8 jimg)
+jpImageRGB8ToImage jimg = jpCSError "RGB8 (Pixel RGB Word8)" jimg
+{-# INLINE jpImageRGB8ToImage #-}
+
+jpImageRGB16ToImage :: JP.DynamicImage -> Either String (Image VS RGB Word16)
+jpImageRGB16ToImage (JP.ImageRGB16 jimg) = Right (fromJPImageRGB16 jimg)
+jpImageRGB16ToImage jimg = jpCSError "RGB16 (Pixel RGB Word16)" jimg
+{-# INLINE jpImageRGB16ToImage #-}
+
+jpImageRGBFToImage :: JP.DynamicImage -> Either String (Image VS RGB Float)
+jpImageRGBFToImage (JP.ImageRGBF jimg) = Right (fromJPImageRGBF jimg)
+jpImageRGBFToImage jimg = jpCSError "RGBF (Pixel RGB Float)" jimg
+{-# INLINE jpImageRGBFToImage #-}
+
+jpImageRGBA8ToImage :: JP.DynamicImage -> Either String (Image VS RGBA Word8)
+jpImageRGBA8ToImage (JP.ImageRGBA8 jimg) = Right (fromJPImageRGBA8 jimg)
+jpImageRGBA8ToImage jimg = jpCSError "RGBA8 (Pixel RGBA Word8)" jimg
+{-# INLINE jpImageRGBA8ToImage #-}
+
+jpImageRGBA16ToImage :: JP.DynamicImage -> Either String (Image VS RGBA Word16)
+jpImageRGBA16ToImage (JP.ImageRGBA16 jimg) = Right (fromJPImageRGBA16 jimg)
+jpImageRGBA16ToImage jimg = jpCSError "RGBA16 (Pixel RGBA Word16)" jimg
+{-# INLINE jpImageRGBA16ToImage #-}
+
+jpImageYCbCr8ToImage :: JP.DynamicImage -> Either String (Image VS YCbCr Word8)
+jpImageYCbCr8ToImage (JP.ImageYCbCr8 jimg) = Right (fromJPImageYCbCr8 jimg)
+jpImageYCbCr8ToImage jimg = jpCSError "YCbCr8 (Pixel YCbCr Word8)" jimg
+{-# INLINE jpImageYCbCr8ToImage #-}
+
+jpImageCMYK8ToImage :: JP.DynamicImage -> Either String (Image VS CMYK Word8)
+jpImageCMYK8ToImage (JP.ImageCMYK8 jimg) = Right (fromJPImageCMYK8 jimg)
+jpImageCMYK8ToImage jimg = jpCSError "CMYK8 (Pixel CMYK Word8)" jimg
+{-# INLINE jpImageCMYK8ToImage #-}
+
+jpImageCMYK16ToImage :: JP.DynamicImage -> Either String (Image VS CMYK Word16)
+jpImageCMYK16ToImage (JP.ImageCMYK16 jimg) = Right (fromJPImageCMYK16 jimg)
+jpImageCMYK16ToImage jimg = jpCSError "CMYK16 (Pixel CMYK Word16)" jimg
+{-# INLINE jpImageCMYK16ToImage #-}
+
+
+jpDynamicImageToImage
+  :: (Convertible cs e, ColorSpace cs e, V.Storable (Pixel cs e)) =>
+     JP.DynamicImage -> Image VS cs e
+jpDynamicImageToImage (JP.ImageY8 jimg)     = convert $ fromJPImageY8 jimg
+jpDynamicImageToImage (JP.ImageYA8 jimg)    = convert $ fromJPImageYA8 jimg
+jpDynamicImageToImage (JP.ImageY16 jimg)    = convert $ fromJPImageY16 jimg
+jpDynamicImageToImage (JP.ImageYA16 jimg)   = convert $ fromJPImageYA16 jimg
+jpDynamicImageToImage (JP.ImageYF jimg)     = convert $ fromJPImageYF jimg
+jpDynamicImageToImage (JP.ImageRGB8 jimg)   = convert $ fromJPImageRGB8 jimg
+jpDynamicImageToImage (JP.ImageRGBA8 jimg)  = convert $ fromJPImageRGBA8 jimg
+jpDynamicImageToImage (JP.ImageRGB16 jimg)  = convert $ fromJPImageRGB16 jimg
+jpDynamicImageToImage (JP.ImageRGBA16 jimg) = convert $ fromJPImageRGBA16 jimg
+jpDynamicImageToImage (JP.ImageRGBF jimg)   = convert $ fromJPImageRGBF jimg
+jpDynamicImageToImage (JP.ImageYCbCr8 jimg) = convert $ fromJPImageYCbCr8 jimg
+jpDynamicImageToImage (JP.ImageCMYK8 jimg)  = convert $ fromJPImageCMYK8 jimg
+jpDynamicImageToImage (JP.ImageCMYK16 jimg) = convert $ fromJPImageCMYK16 jimg
+{-# INLINE jpDynamicImageToImage #-}
+
+
+jpImageShowCS :: JP.DynamicImage -> String
+jpImageShowCS (JP.ImageY8 _)     = "Y8 (Pixel Y Word8)"
+jpImageShowCS (JP.ImageY16 _)    = "Y16 (Pixel Y Word16)"
+jpImageShowCS (JP.ImageYF _)     = "YF (Pixel Y Float)"
+jpImageShowCS (JP.ImageYA8 _)    = "YA8 (Pixel YA Word8)"
+jpImageShowCS (JP.ImageYA16 _)   = "YA16 (Pixel YA Word16)"
+jpImageShowCS (JP.ImageRGB8 _)   = "RGB8 (Pixel RGB Word8)"
+jpImageShowCS (JP.ImageRGB16 _)  = "RGB16 (Pixel RGB Word16)"
+jpImageShowCS (JP.ImageRGBF _)   = "RGBF (Pixel RGB Float)"
+jpImageShowCS (JP.ImageRGBA8 _)  = "RGBA8 (Pixel RGBA Word8)"
+jpImageShowCS (JP.ImageRGBA16 _) = "RGBA16 (Pixel RGBA Word16)"
+jpImageShowCS (JP.ImageYCbCr8 _) = "YCbCr8 (Pixel YCbCr Word8)"
+jpImageShowCS (JP.ImageCMYK8 _)  = "CMYK8 (Pixel CMYK Word8)"
+jpImageShowCS (JP.ImageCMYK16 _) = "CMYK16 (Pixel CMYK Word16)"
+
+
+jpError :: String -> Either String a
+jpError err = Left $ "JuicyPixel decoding error: " ++ err
+
+
+jpCSError :: String -> JP.DynamicImage -> Either String a
+jpCSError cs jimg =
+  jpError $
+  "Input image is in " ++
+  jpImageShowCS jimg ++ ", cannot convert it to " ++ cs ++ " colorspace."
+
+
+
+-- | Bitmap image with @.bmp@ extension.
+data BMP = BMP deriving Show
+
+instance ImageFormat BMP where
+  data SaveOption BMP
+
+  ext _ = ".bmp"
+
+
+--------------------------------------------------------------------------------
+-- Decoding BMP Format ---------------------------------------------------------
+--------------------------------------------------------------------------------
+
+instance Readable (Image VS X Bit) BMP where
+  decode _ = fmap toImageBinary . jpImageY8ToImage <=< JP.decodeBitmap
+
+instance Readable (Image VS Y Word8) BMP where
+  decode _ = jpImageY8ToImage <=< JP.decodeBitmap
+
+instance Readable (Image VS RGB Word8) BMP where
+  decode _ = jpImageRGB8ToImage <=< JP.decodeBitmap
+
+instance Readable (Image VS RGBA Word8) BMP where
+  decode _ = jpImageRGBA8ToImage <=< JP.decodeBitmap
+
+
+instance Readable (Image VS Y Double) BMP where
+  decode _ = fmap jpDynamicImageToImage . JP.decodeBitmap
+
+instance Readable (Image VS YA Double) BMP where
+  decode _ = fmap jpDynamicImageToImage . JP.decodeBitmap
+
+instance Readable (Image VS RGB Double) BMP where
+  decode _ = fmap jpDynamicImageToImage . JP.decodeBitmap
+
+instance Readable (Image VS RGBA Double) BMP where
+  decode _ = fmap jpDynamicImageToImage . JP.decodeBitmap
+
+
+--------------------------------------------------------------------------------
+-- Encoding BMP Format ---------------------------------------------------------
+--------------------------------------------------------------------------------
+
+instance Writable (Image VS Y Word8) BMP where
+  encode _ _ = JP.encodeBitmap . toJPImageY8
+
+instance Writable (Image VS RGB Word8) BMP where
+  encode _ _ = JP.encodeBitmap . toJPImageRGB8
+
+instance Writable (Image VS RGBA Word8) BMP where
+  encode _ _ = JP.encodeBitmap . toJPImageRGBA8
+
+instance Writable (Image VS X Bit) BMP where
+  encode _ _ = JP.encodeBitmap . toJPImageY8 . fromImageBinary
+
+
+instance Writable (Image VS Y Double) BMP where
+  encode _ _ = JP.encodeBitmap . toJPImageY8 . toWord8I
+
+instance Writable (Image VS YA Double) BMP where
+  encode _ _ = JP.encodeBitmap . toJPImageY8 . toWord8I . toImageY
+
+instance Writable (Image VS RGB Double) BMP where
+  encode _ _ = JP.encodeBitmap . toJPImageRGB8 . toWord8I
+
+instance Writable (Image VS RGBA Double) BMP where
+  encode _ _ = JP.encodeBitmap . toJPImageRGBA8 . toWord8I
+
+
+
+-- | Graphics Interchange Format image with @.gif@ extension.
+data GIF = GIF deriving Show
+
+instance ImageFormat GIF where
+  data SaveOption GIF = GIFPalette JP.PaletteOptions
+
+  ext _ = ".gif"
+
+
+-- | Graphics Interchange Format animated image with @.gif@ extension.
+data GIFA = GIFA deriving Show
+{-# DEPRECATED GIFA "use (`Seq` `GIF`) instead" #-}
+
+
+instance ImageFormat GIFA where
+  data SaveOption GIFA = GIFAPalette JP.PaletteOptions
+                       | GIFALooping JP.GifLooping
+
+  ext _ = ext GIF
+
+
+
+instance ImageFormat (Seq GIF) where
+  data SaveOption (Seq GIF) = GIFSeqPalette JP.PaletteOptions
+                            | GIFSeqLooping JP.GifLooping
+  ext _ = ext GIF
+
+
+
+--------------------------------------------------------------------------------
+-- Decoding GIF Format ---------------------------------------------------------
+--------------------------------------------------------------------------------
+
+instance Readable (Image VS RGB Word8) GIF where
+  decode _ = jpImageRGB8ToImage <=< JP.decodeGif
+
+instance Readable (Image VS RGBA Word8) GIF where
+  decode _ = jpImageRGBA8ToImage <=< JP.decodeGif
+
+
+instance Readable (Image VS Y Double) GIF where
+  decode _ = fmap jpDynamicImageToImage . JP.decodeGif
+
+instance Readable (Image VS YA Double) GIF where
+  decode _ = fmap jpDynamicImageToImage . JP.decodeGif
+
+instance Readable (Image VS RGB Double) GIF where
+  decode _ = fmap jpDynamicImageToImage . JP.decodeGif
+
+instance Readable (Image VS RGBA Double) GIF where
+  decode _ = fmap jpDynamicImageToImage . JP.decodeGif
+
+
+-- Animated GIF Format frames reading into a list
+
+decodeGifs :: (JP.DynamicImage -> Either String img)
+           -> B.ByteString -> Either String [img]
+decodeGifs decoder bs = do
+  imgs <- JP.decodeGifImages bs
+  sequence $ fmap decoder imgs
+
+
+decodeGifsDelays :: (JP.DynamicImage -> Either String img)
+                 -> B.ByteString -> Either String [(JP.GifDelay, img)]
+decodeGifsDelays decoder bs = do
+  imgs <- JP.decodeGifImages bs
+  delays <- JP.getDelaysGifImages bs
+  gifs <- sequence $ fmap decoder imgs
+  return $ zip delays gifs
+
+
+
+instance Readable [Image VS RGB Word8] GIFA where
+  decode _ = decodeGifs jpImageRGB8ToImage
+
+instance Readable [Image VS RGBA Word8] GIFA where
+  decode _ = decodeGifs jpImageRGBA8ToImage
+
+instance Readable [(JP.GifDelay, Image VS RGB Word8)] GIFA where
+  decode _ = decodeGifsDelays jpImageRGB8ToImage
+
+instance Readable [(JP.GifDelay, Image VS RGBA Word8)] GIFA where
+  decode _ = decodeGifsDelays jpImageRGBA8ToImage
+
+
+
+instance Readable [Image VS Y Double] GIFA where
+  decode _ = decodeGifs (Right . jpDynamicImageToImage)
+
+instance Readable [Image VS YA Double] GIFA where
+  decode _ = decodeGifs (Right . jpDynamicImageToImage)
+
+instance Readable [Image VS RGB Double] GIFA where
+  decode _ = decodeGifs (Right . jpDynamicImageToImage)
+
+instance Readable [Image VS RGBA Double] GIFA where
+  decode _ = decodeGifs (Right . jpDynamicImageToImage)
+
+
+instance Readable [Image VS RGB Word8] (Seq GIF) where
+  decode _ = decodeGifs jpImageRGB8ToImage
+
+instance Readable [Image VS RGBA Word8] (Seq GIF) where
+  decode _ = decodeGifs jpImageRGBA8ToImage
+
+instance Readable [(JP.GifDelay, Image VS RGB Word8)] (Seq GIF) where
+  decode _ = decodeGifsDelays jpImageRGB8ToImage
+
+instance Readable [(JP.GifDelay, Image VS RGBA Word8)] (Seq GIF) where
+  decode _ = decodeGifsDelays jpImageRGBA8ToImage
+
+
+
+instance Readable [Image VS Y Double] (Seq GIF) where
+  decode _ = decodeGifs (Right . jpDynamicImageToImage)
+
+instance Readable [Image VS YA Double] (Seq GIF) where
+  decode _ = decodeGifs (Right . jpDynamicImageToImage)
+
+instance Readable [Image VS RGB Double] (Seq GIF) where
+  decode _ = decodeGifs (Right . jpDynamicImageToImage)
+
+instance Readable [Image VS RGBA Double] (Seq GIF) where
+  decode _ = decodeGifs (Right . jpDynamicImageToImage)
+
+
+
+--------------------------------------------------------------------------------
+-- Encoding GIF Format ---------------------------------------------------------
+--------------------------------------------------------------------------------
+
+encodeGIF :: [SaveOption GIF]
+          -> Image VS RGB Word8
+          -> BL.ByteString
+encodeGIF []                     =
+  either error id . uncurry JP.encodeGifImageWithPalette .
+  JP.palettize JP.defaultPaletteOptions . toJPImageRGB8
+encodeGIF (GIFPalette palOpts:_) =
+  either error id . uncurry JP.encodeGifImageWithPalette .
+  JP.palettize palOpts . toJPImageRGB8
+{-# INLINE encodeGIF #-}
+
+instance Writable (Image VS RGB Word8) GIF where
+  encode _ = encodeGIF
+
+instance Writable (Image VS Y Double) GIF where
+  encode _ _ = JP.encodeGifImage . toJPImageY8 . toWord8I
+
+instance Writable (Image VS YA Double) GIF where
+  encode f opts = encode f opts . toImageY
+
+instance Writable (Image VS RGB Double) GIF where
+  encode _ opts = encodeGIF opts . toWord8I
+
+instance Writable (Image VS RGBA Double) GIF where
+  encode f opts = encode f opts . toImageRGB
+
+
+encodeGIFA :: [SaveOption GIFA]
+           -> [(JP.GifDelay, Image VS RGB Word8)] -> BL.ByteString
+encodeGIFA !opts =
+  either error id . JP.encodeGifImages (getGIFALoop opts) . P.map palletizeGif where
+    getGIFALoop []                = JP.LoopingNever
+    getGIFALoop (GIFALooping l:_) = l
+    getGIFALoop (_:xs)            = getGIFALoop xs
+    getGIFAPal []                      = JP.defaultPaletteOptions
+    getGIFAPal (GIFAPalette palOpts:_) = palOpts
+    getGIFAPal (_:xs)                  = getGIFAPal xs
+    palletizeGif !(d, img) = (p, d, jimg) where
+      !(jimg, p) = JP.palettize (getGIFAPal opts) $ toJPImageRGB8 img
+
+
+instance Writable [(JP.GifDelay, Image VS RGB Word8)] GIFA where
+  encode _ opts = encodeGIFA opts
+
+instance Writable [(JP.GifDelay, Image VS RGB Double)] GIFA where
+  encode _ opts = encodeGIFA opts . fmap (\ !(d, i) -> (d, toWord8I i))
+
+
+encodeGIFSeq :: [SaveOption (Seq GIF)]
+           -> [(JP.GifDelay, Image VS RGB Word8)] -> BL.ByteString
+encodeGIFSeq !opts =
+  either error id . JP.encodeGifImages (getGIFSeqLoop opts) . P.map palletizeGif where
+    getGIFSeqLoop []                  = JP.LoopingNever
+    getGIFSeqLoop (GIFSeqLooping l:_) = l
+    getGIFSeqLoop (_:xs)              = getGIFSeqLoop xs
+    getGIFSeqPal []                        = JP.defaultPaletteOptions
+    getGIFSeqPal (GIFSeqPalette palOpts:_) = palOpts
+    getGIFSeqPal (_:xs)                    = getGIFSeqPal xs
+    palletizeGif !(d, img) = (p, d, jimg) where
+      !(jimg, p) = JP.palettize (getGIFSeqPal opts) $ toJPImageRGB8 img
+    {-# INLINE palletizeGif #-}
+{-# INLINE encodeGIFSeq #-}
+
+instance Writable [(JP.GifDelay, Image VS RGB Word8)] (Seq GIF) where
+  encode _ opts = encodeGIFSeq opts
+
+instance Writable [(JP.GifDelay, Image VS RGB Double)] (Seq GIF) where
+  encode _ opts = encodeGIFSeq opts . fmap (fmap toWord8I)
+
+
+
+
+
+
+-- | High-dynamic-range image with @.hdr@ or @.pic@ extension.
+data HDR = HDR deriving Show
+
+instance ImageFormat HDR where
+  data SaveOption HDR
+
+  ext _ = ".hdr"
+
+  exts _ = [".hdr", ".pic"]
+
+
+--------------------------------------------------------------------------------
+-- Decoding HDR Format ---------------------------------------------------------
+--------------------------------------------------------------------------------
+
+instance Readable (Image VS RGB Float) HDR where
+  decode _ = jpImageRGBFToImage <=< JP.decodeHDR
+
+
+instance Readable (Image VS Y Double) HDR where
+  decode _ = fmap jpDynamicImageToImage . JP.decodeHDR
+
+instance Readable (Image VS YA Double) HDR where
+  decode _ = fmap jpDynamicImageToImage . JP.decodeHDR
+
+instance Readable (Image VS RGB Double) HDR where
+  decode _ = fmap jpDynamicImageToImage . JP.decodeHDR
+
+instance Readable (Image VS RGBA Double) HDR where
+  decode _ = fmap jpDynamicImageToImage . JP.decodeHDR
+
+
+--------------------------------------------------------------------------------
+-- Encoding HDR Format ---------------------------------------------------------
+--------------------------------------------------------------------------------
+
+instance Writable (Image VS RGB Float) HDR where
+  encode _ _ = JP.encodeHDR . toJPImageRGBF
+
+instance Writable (Image VS Y Double) HDR where
+  encode _ _ = JP.encodeHDR . toJPImageRGBF . toFloatI . toImageRGB
+
+instance Writable (Image VS YA Double) HDR where
+  encode _ _ = JP.encodeHDR . toJPImageRGBF . toFloatI . toImageRGB
+
+instance Writable (Image VS RGB Double) HDR where
+  encode _ _ = JP.encodeHDR . toJPImageRGBF . toFloatI
+
+instance Writable (Image VS RGBA Double) HDR where
+  encode _ _ = JP.encodeHDR . toJPImageRGBF . toFloatI . toImageRGB
+
+
+-- | Joint Photographic Experts Group image with @.jpg@ or @.jpeg@ extension.
+data JPG = JPG deriving Show
+
+instance ImageFormat JPG where
+  data SaveOption JPG = JPGQuality Word8
+
+  ext _ = ".jpg"
+
+  exts _ = [".jpg", ".jpeg"]
+
+
+--------------------------------------------------------------------------------
+-- Decoding JPG Format ---------------------------------------------------------
+--------------------------------------------------------------------------------
+
+instance Readable (Image VS Y Word8) JPG where
+  decode _ = jpImageY8ToImage <=< JP.decodeJpeg
+
+instance Readable (Image VS YA Word8) JPG where
+  decode _ = jpImageYA8ToImage <=< JP.decodeJpeg
+
+instance Readable (Image VS RGB Word8) JPG where
+  decode _ = jpImageRGB8ToImage <=< JP.decodeJpeg
+
+instance Readable (Image VS CMYK Word8) JPG where
+  decode _ = jpImageCMYK8ToImage <=< JP.decodeJpeg
+
+instance Readable (Image VS YCbCr Word8) JPG where
+  decode _ = jpImageYCbCr8ToImage <=< JP.decodeJpeg
+
+
+instance Readable (Image VS Y Double) JPG where
+  decode _ = fmap jpDynamicImageToImage . JP.decodeJpeg
+
+instance Readable (Image VS YA Double) JPG where
+  decode _ = fmap jpDynamicImageToImage . JP.decodeJpeg
+
+instance Readable (Image VS RGB Double) JPG where
+  decode _ = fmap jpDynamicImageToImage . JP.decodeJpeg
+
+instance Readable (Image VS RGBA Double) JPG where
+  decode _ = fmap jpDynamicImageToImage . JP.decodeJpeg
+
+
+--------------------------------------------------------------------------------
+-- Encoding JPG Format ---------------------------------------------------------
+--------------------------------------------------------------------------------
+
+encodeJPG
+  :: JP.JpgEncodable px
+  => [SaveOption JPG] -> JP.Image px -> BL.ByteString
+encodeJPG []               =
+  JP.encodeDirectJpegAtQualityWithMetadata 100 M.mempty
+encodeJPG (JPGQuality q:_) =
+  JP.encodeDirectJpegAtQualityWithMetadata q M.mempty
+{-# INLINE encodeJPG #-}
+
+instance Writable (Image VS Y Word8) JPG where
+  encode _ opts = encodeJPG opts . toJPImageY8
+
+instance Writable (Image VS RGB Word8) JPG where
+  encode _ opts = encodeJPG opts . toJPImageRGB8
+
+instance Writable (Image VS CMYK Word8) JPG where
+  encode _ opts = encodeJPG opts . toJPImageCMYK8
+
+instance Writable (Image VS YCbCr Word8) JPG where
+  encode _ opts = encodeJPG opts . toJPImageYCbCr8
+
+-- | Image is converted `YCbCr` color space prior to encoding.
+instance Writable (Image VS Y Double) JPG where
+  encode _ opts = encodeJPG opts . toJPImageYCbCr8 . toWord8I . toImageYCbCr
+
+-- | Image is converted `YCbCr` color space prior to encoding.
+instance Writable (Image VS YA Double) JPG where
+  encode _ opts = encodeJPG opts . toJPImageYCbCr8 . toWord8I . toImageYCbCr
+
+-- | Image is converted `YCbCr` color space prior to encoding.
+instance Writable (Image VS RGB Double) JPG where
+  encode _ opts = encodeJPG opts . toJPImageYCbCr8 . toWord8I . toImageYCbCr
+
+-- | Image is converted `YCbCr` color space prior to encoding.
+instance Writable (Image VS RGBA Double) JPG where
+  encode _ opts = encodeJPG opts . toJPImageYCbCr8 . toWord8I . toImageYCbCr
+
+
+
+
+-- | Portable Network Graphics image with @.png@ extension.
+data PNG = PNG deriving Show
+
+instance ImageFormat PNG where
+  data SaveOption PNG
+
+  ext _ = ".png"
+
+
+
+--------------------------------------------------------------------------------
+-- Decoding PNG Format ---------------------------------------------------------
+--------------------------------------------------------------------------------
+
+instance Readable (Image VS X Bit) PNG where
+  decode _ = fmap toImageBinary . jpImageY8ToImage <=< JP.decodePng
+
+instance Readable (Image VS Y Word8) PNG where
+  decode _ = jpImageY8ToImage <=< JP.decodePng
+
+instance Readable (Image VS Y Word16) PNG where
+  decode _ = jpImageY16ToImage <=< JP.decodePng
+
+instance Readable (Image VS YA Word8) PNG where
+  decode _ = jpImageYA8ToImage <=< JP.decodePng
+
+instance Readable (Image VS YA Word16) PNG where
+  decode _ = jpImageYA16ToImage <=< JP.decodePng
+
+instance Readable (Image VS RGB Word8) PNG where
+  decode _ = jpImageRGB8ToImage <=< JP.decodePng
+
+instance Readable (Image VS RGB Word16) PNG where
+  decode _ = jpImageRGB16ToImage <=< JP.decodePng
+
+instance Readable (Image VS RGBA Word8) PNG where
+  decode _ = jpImageRGBA8ToImage <=< JP.decodePng
+
+instance Readable (Image VS RGBA Word16) PNG where
+  decode _ = jpImageRGBA16ToImage <=< JP.decodePng
+
+
+instance Readable (Image VS Y Double) PNG where
+  decode _ = fmap jpDynamicImageToImage . JP.decodePng
+
+instance Readable (Image VS YA Double) PNG where
+  decode _ = fmap jpDynamicImageToImage . JP.decodePng
+
+instance Readable (Image VS RGB Double) PNG where
+  decode _ = fmap jpDynamicImageToImage . JP.decodePng
+
+instance Readable (Image VS RGBA Double) PNG where
+  decode _ = fmap jpDynamicImageToImage . JP.decodePng
+
+
+--------------------------------------------------------------------------------
+-- Encoding PNG Format ---------------------------------------------------------
+--------------------------------------------------------------------------------
+
+instance Writable (Image VS X Bit) PNG where
+  encode _ _ = JP.encodePng . toJPImageY8 . fromImageBinary
+
+instance Writable (Image VS Y Word8) PNG where
+  encode _ _ = JP.encodePng . toJPImageY8
+
+instance Writable (Image VS Y Word16) PNG where
+  encode _ _ = JP.encodePng . toJPImageY16
+
+instance Writable (Image VS YA Word8) PNG where
+  encode _ _ = JP.encodePng . toJPImageYA8
+
+instance Writable (Image VS YA Word16) PNG where
+  encode _ _ = JP.encodePng . toJPImageYA16
+
+instance Writable (Image VS RGB Word8) PNG where
+  encode _ _ = JP.encodePng . toJPImageRGB8
+
+instance Writable (Image VS RGB Word16) PNG where
+  encode _ _ = JP.encodePng . toJPImageRGB16
+
+instance Writable (Image VS RGBA Word8) PNG where
+  encode _ _ = JP.encodePng . toJPImageRGBA8
+
+instance Writable (Image VS RGBA Word16) PNG where
+  encode _ _ = JP.encodePng . toJPImageRGBA16
+
+
+instance Writable (Image VS Y Double) PNG where
+  encode _ _ = JP.encodePng . toJPImageY16 . toWord16I
+
+instance Writable (Image VS YA Double) PNG where
+  encode _ _ = JP.encodePng . toJPImageYA16 . toWord16I
+
+instance Writable (Image VS RGB Double) PNG where
+  encode _ _ = JP.encodePng . toJPImageRGB16 . toWord16I
+
+instance Writable (Image VS RGBA Double) PNG where
+  encode _ _ = JP.encodePng . toJPImageRGBA16 . toWord16I
+
+
+
+
+
+
+-- | Truevision Graphics Adapter image with .tga extension.
+data TGA = TGA
+
+instance ImageFormat TGA where
+  data SaveOption TGA
+
+  ext _ = ".tga"
+
+
+--------------------------------------------------------------------------------
+-- Decoding TGA Format ---------------------------------------------------------
+--------------------------------------------------------------------------------
+
+instance Readable (Image VS X Bit) TGA where
+  decode _ = fmap toImageBinary . jpImageY8ToImage <=< JP.decodeTga
+
+instance Readable (Image VS Y Word8) TGA where
+  decode _ = jpImageY8ToImage <=< JP.decodeTga
+
+instance Readable (Image VS RGB Word8) TGA where
+  decode _ = jpImageRGB8ToImage <=< JP.decodeTga
+
+instance Readable (Image VS RGBA Word8) TGA where
+  decode _ = jpImageRGBA8ToImage <=< JP.decodeTga
+
+
+instance Readable (Image VS Y Double) TGA where
+  decode _ = fmap jpDynamicImageToImage . JP.decodeTga
+
+instance Readable (Image VS YA Double) TGA where
+  decode _ = fmap jpDynamicImageToImage . JP.decodeTga
+
+instance Readable (Image VS RGB Double) TGA where
+  decode _ = fmap jpDynamicImageToImage . JP.decodeTga
+
+instance Readable (Image VS RGBA Double) TGA where
+  decode _ = fmap jpDynamicImageToImage . JP.decodeTga
+
+
+--------------------------------------------------------------------------------
+-- Encoding TGA Format ---------------------------------------------------------
+--------------------------------------------------------------------------------
+
+instance Writable (Image VS X Bit) TGA where
+  encode _ _ = JP.encodeTga . toJPImageY8 . fromImageBinary
+
+instance Writable (Image VS Y Word8) TGA where
+  encode _ _ = JP.encodeTga . toJPImageY8
+
+instance Writable (Image VS RGB Word8) TGA where
+  encode _ _ = JP.encodeTga . toJPImageRGB8
+
+instance Writable (Image VS RGBA Word8) TGA where
+  encode _ _ = JP.encodeTga . toJPImageRGBA8
+
+
+instance Writable (Image VS Y Double) TGA where
+  encode _ _ = JP.encodeTga . toJPImageY8 . toWord8I
+
+instance Writable (Image VS YA Double) TGA where
+  encode _ _ = JP.encodeTga . toJPImageY8 . toWord8I . toImageY
+
+instance Writable (Image VS RGB Double) TGA where
+  encode _ _ = JP.encodeTga . toJPImageRGB8 . toWord8I
+
+instance Writable (Image VS RGBA Double) TGA where
+  encode _ _ = JP.encodeTga . toJPImageRGBA8 . toWord8I
+
+
+
+-- | Tagged Image File Format image with @.tif@ or @.tiff@ extension.
+data TIF = TIF deriving Show
+
+instance ImageFormat TIF where
+  data SaveOption TIF
+
+  ext _ = ".tif"
+
+  exts _ = [".tif", ".tiff"]
+
+
+--------------------------------------------------------------------------------
+-- Decoding TIF Format ---------------------------------------------------------
+--------------------------------------------------------------------------------
+
+instance Readable (Image VS X Bit) TIF where
+  decode _ = fmap toImageBinary . jpImageY8ToImage <=< JP.decodeTiff
+
+instance Readable (Image VS Y Word8) TIF where
+  decode _ = jpImageY8ToImage <=< JP.decodeTiff
+
+instance Readable (Image VS Y Word16) TIF where
+  decode _ = jpImageY16ToImage <=< JP.decodeTiff
+
+instance Readable (Image VS YA Word8) TIF where
+  decode _ = jpImageYA8ToImage <=< JP.decodeTiff
+
+instance Readable (Image VS YA Word16) TIF where
+  decode _ = jpImageYA16ToImage <=< JP.decodeTiff
+
+instance Readable (Image VS RGB Word8) TIF where
+  decode _ = jpImageRGB8ToImage <=< JP.decodeTiff
+
+instance Readable (Image VS RGB Word16) TIF where
+  decode _ = jpImageRGB16ToImage <=< JP.decodeTiff
+
+instance Readable (Image VS RGBA Word8) TIF where
+  decode _ = jpImageRGBA8ToImage <=< JP.decodeTiff
+
+instance Readable (Image VS RGBA Word16) TIF where
+  decode _ = jpImageRGBA16ToImage <=< JP.decodeTiff
+
+instance Readable (Image VS CMYK Word8) TIF where
+  decode _ = jpImageCMYK8ToImage <=< JP.decodeTiff
+
+instance Readable (Image VS CMYK Word16) TIF where
+  decode _ = jpImageCMYK16ToImage <=< JP.decodeTiff
+
+
+instance Readable (Image VS Y Double) TIF where
+  decode _ = fmap jpDynamicImageToImage . JP.decodeTiff
+
+instance Readable (Image VS YA Double) TIF where
+  decode _ = fmap jpDynamicImageToImage . JP.decodeTiff
+
+instance Readable (Image VS RGB Double) TIF where
+  decode _ = fmap jpDynamicImageToImage . JP.decodeTiff
+
+instance Readable (Image VS RGBA Double) TIF where
+  decode _ = fmap jpDynamicImageToImage . JP.decodeTiff
+
+
+--------------------------------------------------------------------------------
+-- Encoding TIF Format ---------------------------------------------------------
+--------------------------------------------------------------------------------
+
+instance Writable (Image VS Y Word8) TIF where
+  encode _ _ = JP.encodeTiff . toJPImageY8
+
+instance Writable (Image VS Y Word16) TIF where
+  encode _ _ = JP.encodeTiff . toJPImageY16
+
+instance Writable (Image VS YA Word8) TIF where
+  encode _ _ = JP.encodeTiff . toJPImageYA8
+
+instance Writable (Image VS YA Word16) TIF where
+  encode _ _ = JP.encodeTiff . toJPImageYA16
+
+instance Writable (Image VS RGB Word8) TIF where
+  encode _ _ = JP.encodeTiff . toJPImageRGB8
+
+instance Writable (Image VS RGB Word16) TIF where
+  encode _ _ = JP.encodeTiff . toJPImageRGB16
+
+instance Writable (Image VS RGBA Word8) TIF where
+  encode _ _ = JP.encodeTiff . toJPImageRGBA8
+
+instance Writable (Image VS RGBA Word16) TIF where
+  encode _ _ = JP.encodeTiff . toJPImageRGBA16
+
+instance Writable (Image VS YCbCr Word8) TIF where
+  encode _ _ = JP.encodeTiff . toJPImageYCbCr8
+
+instance Writable (Image VS CMYK Word8) TIF where
+  encode _ _ = JP.encodeTiff . toJPImageCMYK8
+
+instance Writable (Image VS CMYK Word16) TIF where
+  encode _ _ = JP.encodeTiff . toJPImageCMYK16
+
+
+instance Writable (Image VS X Bit) TIF where
+  encode _ _ = JP.encodeTiff . toJPImageY8 . fromImageBinary
+
+instance Writable (Image VS Y Double) TIF where
+  encode _ _ = JP.encodeTiff . toJPImageY16 . toWord16I
+
+instance Writable (Image VS YA Double) TIF where
+  encode _ _ = JP.encodeTiff . toJPImageYA16 . toWord16I
+
+instance Writable (Image VS RGB Double) TIF where
+  encode _ _ = JP.encodeTiff . toJPImageRGB16 . toWord16I
+
+instance Writable (Image VS RGBA Double) TIF where
+  encode _ _ = JP.encodeTiff . toJPImageRGBA16 . toWord16I
+
+instance Writable (Image VS YCbCr Double) TIF where
+  encode _ _ = JP.encodeTiff . toJPImageYCbCr8 . toWord8I
+
+instance Writable (Image VS CMYK Double) TIF where
+  encode _ _ = JP.encodeTiff . toJPImageCMYK16 . toWord16I
+
+
diff --git a/src/Graphics/Image/IO/Formats/JuicyPixels/Common.hs b/src/Graphics/Image/IO/Formats/JuicyPixels/Common.hs
deleted file mode 100644
--- a/src/Graphics/Image/IO/Formats/JuicyPixels/Common.hs
+++ /dev/null
@@ -1,112 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE ViewPatterns #-}
--- |
--- Module      : Graphics.Image.IO.Formats.JuicyPixels.Common
--- Copyright   : (c) Alexey Kuleshevich 2017
--- License     : BSD3
--- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
--- Stability   : experimental
--- Portability : non-portable
---
-module Graphics.Image.IO.Formats.JuicyPixels.Common (
-  BMP(..),
-  GIF(..), GIFA(..),
-  JP.GifDelay, JP.GifLooping(..), JP.PaletteOptions(..), JP.PaletteCreationMethod(..),
-  HDR(..),
-  JPG(..),
-  PNG(..),
-  TGA(..),
-  TIF(..),
-  SaveOption(..),
-  ) where
-
-import Graphics.Image.ColorSpace
-import Graphics.Image.IO.Base
-import qualified Codec.Picture as JP
-
-
-
-
-
--- | Bitmap image with @.bmp@ extension.
-data BMP = BMP
-
-instance ImageFormat BMP where
-  data SaveOption BMP
-
-  ext _ = ".bmp"
-
-
--- | Graphics Interchange Format image with @.gif@ extension.
-data GIF = GIF
-
-instance ImageFormat GIF where
-  data SaveOption GIF = GIFPalette JP.PaletteOptions
-  
-  ext _ = ".gif"
-
-
-  -- | Graphics Interchange Format animated image with @.gif@ extension.
-data GIFA = GIFA
-
-instance ImageFormat GIFA where
-  data SaveOption GIFA = GIFAPalette JP.PaletteOptions
-                       | GIFALooping JP.GifLooping
-  
-  ext _ = ext GIF
-
--- | High-dynamic-range image with @.hdr@ or @.pic@ extension.
-data HDR = HDR
-
-instance ImageFormat HDR where
-  data SaveOption HDR
-
-  ext _ = ".hdr"
-
-  exts _ = [".hdr", ".pic"]
-
-
--- | Joint Photographic Experts Group image with @.jpg@ or @.jpeg@ extension.
-data JPG = JPG
-
-instance ImageFormat JPG where
-  data SaveOption JPG = JPGQuality Word8
-
-  ext _ = ".jpg"
-
-  exts _ = [".jpg", ".jpeg"]
-
-
--- | Portable Network Graphics image with @.png@ extension.
-data PNG = PNG
-
-instance ImageFormat PNG where
-  data SaveOption PNG
-
-  ext _ = ".png"
-
-
--- | Truevision Graphics Adapter image with .tga extension.
-data TGA = TGA
-
-instance ImageFormat TGA where
-  data SaveOption TGA
-
-  ext _ = ".tga"
-
-
--- | Tagged Image File Format image with @.tif@ or @.tiff@ extension.
-data TIF = TIF
-
-instance ImageFormat TIF where
-  data SaveOption TIF  
-
-  ext _ = ".tif"
-
-  exts _ = [".tif", ".tiff"]
diff --git a/src/Graphics/Image/IO/Formats/JuicyPixels/Readable.hs b/src/Graphics/Image/IO/Formats/JuicyPixels/Readable.hs
deleted file mode 100644
--- a/src/Graphics/Image/IO/Formats/JuicyPixels/Readable.hs
+++ /dev/null
@@ -1,568 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE ViewPatterns #-}
--- |
--- Module      : Graphics.Image.IO.Formats.JuicyPixels.Readable
--- Copyright   : (c) Alexey Kuleshevich 2017
--- License     : BSD3
--- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
--- Stability   : experimental
--- Portability : non-portable
---
-module Graphics.Image.IO.Formats.JuicyPixels.Readable () where
-
-import Prelude as P
-
-import Graphics.Image.ColorSpace
-import Graphics.Image.Interface as I
-import Graphics.Image.Interface.Vector
-import Graphics.Image.IO.Base
-import Graphics.Image.IO.Formats.JuicyPixels.Common
-import qualified Data.ByteString as B  -- (ByteString)
-import qualified Codec.Picture as JP
-import qualified Codec.Picture.Types as JP
-import qualified Codec.Picture.Gif as JP
-import qualified Data.Vector.Storable as V
-
-
---------------------------------------------------------------------------------
--- Converting to and from JuicyPixels ------------------------------------------
---------------------------------------------------------------------------------
-
----- to JuicyPixels -----
-
----- Exact precision conversions
-
-instance Convertible JP.Pixel8 (Pixel Y Word8) where
-  convert = PixelY
-  
-instance Convertible JP.Pixel16 (Pixel Y Word16) where
-  convert = PixelY
-
-instance Convertible JP.Pixel32 (Pixel Y Word32) where
-  convert = PixelY
-
-instance Convertible JP.PixelF (Pixel Y Float) where
-  convert = PixelY
-
-instance Convertible JP.PixelYA8 (Pixel YA Word8) where
-  convert (JP.PixelYA8 g a) = PixelYA g a
-  
-instance Convertible JP.PixelYA16 (Pixel YA Word16) where
-  convert (JP.PixelYA16 g a) = PixelYA g a
-
-instance Convertible JP.PixelRGB8 (Pixel RGB Word8) where
-  convert (JP.PixelRGB8 r g b) = PixelRGB r g b
-  
-instance Convertible JP.PixelRGB16 (Pixel RGB Word16) where
-  convert (JP.PixelRGB16 r g b) = PixelRGB r g b
-
-instance Convertible JP.PixelRGBF (Pixel RGB Float) where
-  convert (JP.PixelRGBF r g b) = PixelRGB r g b
-
-instance Convertible JP.PixelRGBA8 (Pixel RGBA Word8) where
-  convert (JP.PixelRGBA8 r g b a) = PixelRGBA r g b a
-  
-instance Convertible JP.PixelRGBA16 (Pixel RGBA Word16) where
-  convert (JP.PixelRGBA16 r g b a) = PixelRGBA r g b a
-
-instance Convertible JP.PixelYCbCr8 (Pixel YCbCr Word8) where
-  convert (JP.PixelYCbCr8 y cb cr) = PixelYCbCr y cb cr
-
-instance Convertible JP.PixelCMYK8 (Pixel CMYK Word8) where
-  convert (JP.PixelCMYK8 c m y k) = PixelCMYK c m y k
-
-instance Convertible JP.PixelCMYK16 (Pixel CMYK Word16) where
-  convert (JP.PixelCMYK16 c m y k) = PixelCMYK c m y k
-
-
-
-instance Convertible (Pixel Y Word8) JP.Pixel8 where
-  convert (PixelY y) = y
-  
-instance Convertible (Pixel Y Word16) JP.Pixel16 where
-  convert (PixelY y) = y
-
-instance Convertible (Pixel Y Word32) JP.Pixel32 where
-  convert (PixelY y) = y
-
-instance Convertible (Pixel Y Float) JP.PixelF where
-  convert (PixelY y) = y
-
-instance Convertible (Pixel YA Word8) JP.PixelYA8 where
-  convert (PixelYA y a) = JP.PixelYA8 y a
-  
-instance Convertible (Pixel YA Word16) JP.PixelYA16 where
-  convert (PixelYA y a) = JP.PixelYA16 y a
-
-instance Convertible (Pixel RGB Word8) JP.PixelRGB8 where
-  convert (PixelRGB r g b) = JP.PixelRGB8 r g b
-  
-instance Convertible (Pixel RGB Word16) JP.PixelRGB16 where
-  convert (PixelRGB r g b) = JP.PixelRGB16 r g b
-
-instance Convertible (Pixel RGB Float) JP.PixelRGBF where
-  convert (PixelRGB r g b) = JP.PixelRGBF r g b
-
-instance Convertible (Pixel RGBA Word8) JP.PixelRGBA8 where
-  convert (PixelRGBA r g b a) = JP.PixelRGBA8 r g b a
-  
-instance Convertible (Pixel RGBA Word16) JP.PixelRGBA16 where
-  convert (PixelRGBA r g b a) = JP.PixelRGBA16 r g b a
-
-instance Convertible (Pixel YCbCr Word8) JP.PixelYCbCr8 where
-  convert (PixelYCbCr y cb cr) = JP.PixelYCbCr8 y cb cr
-
-instance Convertible (Pixel CMYK Word8) JP.PixelCMYK8 where
-  convert (PixelCMYK c m y k) = JP.PixelCMYK8 c m y k
-
-instance Convertible (Pixel CMYK Word16) JP.PixelCMYK16 where
-  convert (PixelCMYK c m y k) = JP.PixelCMYK16 c m y k
-
-
-
---------------------------------------------------------------------------------
--- Decoding images using JuicyPixels ------------------------------------------
---------------------------------------------------------------------------------
-
-
--- BMP Format Reading
-
-instance Readable (Image VS Binary Bit) BMP where
-  decode _ = fmap toImageBinary . jpImageY8ToImage . JP.decodeBitmap
-
-instance Readable (Image VS Y Word8) BMP where
-  decode _ = jpImageY8ToImage . JP.decodeBitmap
-
-instance Readable (Image VS RGB Word8) BMP where
-  decode _ = jpImageRGB8ToImage . JP.decodeBitmap
-
-instance Readable (Image VS RGBA Word8) BMP where
-  decode _ = jpImageRGBA8ToImage . JP.decodeBitmap
-
-
-
--- GIF Format Reading
-
-instance Readable (Image VS RGB Word8) GIF where
-  decode _ = jpImageRGB8ToImage . JP.decodeGif
-
-instance Readable (Image VS RGBA Word8) GIF where
-  decode _ = jpImageRGBA8ToImage . JP.decodeGif
-
-
--- Animated GIF Format frames reading into a list
-
-decodeGifs :: (Either String JP.DynamicImage -> Either String img)
-           -> B.ByteString -> Either String [img]
-decodeGifs decoder bs = do
-  imgs <- JP.decodeGifImages bs
-  sequence $ fmap (decoder . Right) imgs
-
-
-decodeGifsDelays :: (Either String JP.DynamicImage -> Either String img)
-                 -> B.ByteString -> Either String [(GifDelay, img)]
-decodeGifsDelays decoder bs = do
-  imgs <- JP.decodeGifImages bs
-  delays <- JP.getDelaysGifImages bs
-  gifs <- sequence $ fmap (decoder . Right) imgs
-  return $ zip delays gifs
-
-
-
-instance Readable [Image VS RGB Word8] GIFA where
-  decode _ = decodeGifs jpImageRGB8ToImage
-
-instance Readable [Image VS RGBA Word8] GIFA where
-  decode _ = decodeGifs jpImageRGBA8ToImage
-
-instance Readable [(GifDelay, Image VS RGB Word8)] GIFA where
-  decode _ = decodeGifsDelays jpImageRGB8ToImage
-
-instance Readable [(GifDelay, Image VS RGBA Word8)] GIFA where
-  decode _ = decodeGifsDelays jpImageRGBA8ToImage
-
-
--- HDR Format Reading
-
-instance Readable (Image VS RGB Float) HDR where
-  decode _ = jpImageRGBFToImage . JP.decodeHDR
-
-
--- JPG Format Reading
-
-instance Readable (Image VS Y Word8) JPG where
-  decode _ = jpImageY8ToImage . JP.decodeJpeg
-
-instance Readable (Image VS YA Word8) JPG where
-  decode _ = jpImageYA8ToImage . JP.decodeJpeg
-
-instance Readable (Image VS RGB Word8) JPG where
-  decode _ = jpImageRGB8ToImage . JP.decodeJpeg
-
-instance Readable (Image VS CMYK Word8) JPG where
-  decode _ = jpImageCMYK8ToImage . JP.decodeJpeg
-
-instance Readable (Image VS YCbCr Word8) JPG where
-  decode _ = jpImageYCbCr8ToImage . JP.decodeJpeg
-
-
--- PNG Format Reading
-
-instance Readable (Image VS Binary Bit) PNG where
-  decode _ = fmap toImageBinary . jpImageY8ToImage . JP.decodePng
-
-instance Readable (Image VS Y Word8) PNG where
-  decode _ = jpImageY8ToImage . JP.decodePng
-
-instance Readable (Image VS Y Word16) PNG where
-  decode _ = jpImageY16ToImage . JP.decodePng
-
-instance Readable (Image VS YA Word8) PNG where
-  decode _ = jpImageYA8ToImage . JP.decodePng
-
-instance Readable (Image VS YA Word16) PNG where
-  decode _ = jpImageYA16ToImage . JP.decodePng
-
-instance Readable (Image VS RGB Word8) PNG where
-  decode _ = jpImageRGB8ToImage . JP.decodePng
-
-instance Readable (Image VS RGB Word16) PNG where
-  decode _ = jpImageRGB16ToImage . JP.decodePng
-
-instance Readable (Image VS RGBA Word8) PNG where
-  decode _ = jpImageRGBA8ToImage . JP.decodePng
-
-instance Readable (Image VS RGBA Word16) PNG where
-  decode _ = jpImageRGBA16ToImage . JP.decodePng
-
-
--- TGA Format Reading
-
-instance Readable (Image VS Binary Bit) TGA where
-  decode _ = fmap toImageBinary . jpImageY8ToImage . JP.decodeTga
-
-instance Readable (Image VS Y Word8) TGA where
-  decode _ = jpImageY8ToImage . JP.decodeTga
-
-instance Readable (Image VS RGB Word8) TGA where
-  decode _ = jpImageRGB8ToImage . JP.decodeTga
-
-instance Readable (Image VS RGBA Word8) TGA where
-  decode _ = jpImageRGBA8ToImage . JP.decodeTga
-
-
--- TIF Format Reading
-
-instance Readable (Image VS Binary Bit) TIF where
-  decode _ = fmap toImageBinary . jpImageY8ToImage . JP.decodeTiff
-
-instance Readable (Image VS Y Word8) TIF where
-  decode _ = jpImageY8ToImage . JP.decodeTiff
-
-instance Readable (Image VS Y Word16) TIF where
-  decode _ = jpImageY16ToImage . JP.decodeTiff
-
-instance Readable (Image VS YA Word8) TIF where
-  decode _ = jpImageYA8ToImage . JP.decodeTiff
-
-instance Readable (Image VS YA Word16) TIF where
-  decode _ = jpImageYA16ToImage . JP.decodeTiff
-
-instance Readable (Image VS RGB Word8) TIF where
-  decode _ = jpImageRGB8ToImage . JP.decodeTiff
-
-instance Readable (Image VS RGB Word16) TIF where
-  decode _ = jpImageRGB16ToImage . JP.decodeTiff
-
-instance Readable (Image VS RGBA Word8) TIF where
-  decode _ = jpImageRGBA8ToImage . JP.decodeTiff
-
-instance Readable (Image VS RGBA Word16) TIF where
-  decode _ = jpImageRGBA16ToImage . JP.decodeTiff
-
-instance Readable (Image VS CMYK Word8) TIF where
-  decode _ = jpImageCMYK8ToImage . JP.decodeTiff
-
-instance Readable (Image VS CMYK Word16) TIF where
-  decode _ = jpImageCMYK16ToImage . JP.decodeTiff
-
-
--- To Double precision safe conversion
-
-instance Readable (Image VS Y Double) BMP where
-  decode _ = jpDynamicImageToImage . JP.decodeBitmap
-
-instance Readable (Image VS YA Double) BMP where
-  decode _ = jpDynamicImageToImage . JP.decodeBitmap
-
-instance Readable (Image VS RGB Double) BMP where
-  decode _ = jpDynamicImageToImage . JP.decodeBitmap
-
-instance Readable (Image VS RGBA Double) BMP where
-  decode _ = jpDynamicImageToImage . JP.decodeBitmap
-
-
-instance Readable (Image VS Y Double) GIF where
-  decode _ = jpDynamicImageToImage . JP.decodeGif
-
-instance Readable (Image VS YA Double) GIF where
-  decode _ = jpDynamicImageToImage . JP.decodeGif
-
-instance Readable (Image VS RGB Double) GIF where
-  decode _ = jpDynamicImageToImage . JP.decodeGif
-
-instance Readable (Image VS RGBA Double) GIF where
-  decode _ = jpDynamicImageToImage . JP.decodeGif
-
-
-instance Readable [Image VS Y Double] GIFA where
-  decode _ = decodeGifs jpDynamicImageToImage
-
-instance Readable [Image VS YA Double] GIFA where
-  decode _ = decodeGifs jpDynamicImageToImage
-
-instance Readable [Image VS RGB Double] GIFA where
-  decode _ = decodeGifs jpDynamicImageToImage
-
-instance Readable [Image VS RGBA Double] GIFA where
-  decode _ = decodeGifs jpDynamicImageToImage
-
-
-instance Readable (Image VS Y Double) HDR where
-  decode _ = jpDynamicImageToImage . JP.decodeHDR
-
-instance Readable (Image VS YA Double) HDR where
-  decode _ = jpDynamicImageToImage . JP.decodeHDR
-
-instance Readable (Image VS RGB Double) HDR where
-  decode _ = jpDynamicImageToImage . JP.decodeHDR
-
-instance Readable (Image VS RGBA Double) HDR where
-  decode _ = jpDynamicImageToImage . JP.decodeHDR
-
-
-instance Readable (Image VS Y Double) JPG where
-  decode _ = jpDynamicImageToImage . JP.decodeJpeg
-
-instance Readable (Image VS YA Double) JPG where
-  decode _ = jpDynamicImageToImage . JP.decodeJpeg
-
-instance Readable (Image VS RGB Double) JPG where
-  decode _ = jpDynamicImageToImage . JP.decodeJpeg
-
-instance Readable (Image VS RGBA Double) JPG where
-  decode _ = jpDynamicImageToImage . JP.decodeJpeg
-
-
-instance Readable (Image VS Y Double) PNG where
-  decode _ = jpDynamicImageToImage . JP.decodePng
-
-instance Readable (Image VS YA Double) PNG where
-  decode _ = jpDynamicImageToImage . JP.decodePng
-
-instance Readable (Image VS RGB Double) PNG where
-  decode _ = jpDynamicImageToImage . JP.decodePng
-
-instance Readable (Image VS RGBA Double) PNG where
-  decode _ = jpDynamicImageToImage . JP.decodePng
-
-
-instance Readable (Image VS Y Double) TGA where
-  decode _ = jpDynamicImageToImage . JP.decodeTga
-
-instance Readable (Image VS YA Double) TGA where
-  decode _ = jpDynamicImageToImage . JP.decodeTga
-
-instance Readable (Image VS RGB Double) TGA where
-  decode _ = jpDynamicImageToImage . JP.decodeTga
-
-instance Readable (Image VS RGBA Double) TGA where
-  decode _ = jpDynamicImageToImage . JP.decodeTga
-
-
-instance Readable (Image VS Y Double) TIF where
-  decode _ = jpDynamicImageToImage . JP.decodeTiff
-
-instance Readable (Image VS YA Double) TIF where
-  decode _ = jpDynamicImageToImage . JP.decodeTiff
-
-instance Readable (Image VS RGB Double) TIF where
-  decode _ = jpDynamicImageToImage . JP.decodeTiff
-
-instance Readable (Image VS RGBA Double) TIF where
-  decode _ = jpDynamicImageToImage . JP.decodeTiff
-
-
-
--- General decoding and helper functions
-
-jpImageToImageUnsafe :: (Array VS cs e, JP.Pixel jpx) =>
-                        JP.Image jpx -> Image VS cs e
-jpImageToImageUnsafe (JP.Image n m !v) = fromVector (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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 (Pixel Y Word8) (Pixel cs e),
-                           Convertible (Pixel YA Word8) (Pixel cs e),
-                           Convertible (Pixel Y Word16) (Pixel cs e),
-                           Convertible (Pixel YA Word16) (Pixel cs e),
-                           Convertible (Pixel Y Float) (Pixel cs e),
-                           Convertible (Pixel RGB Word8) (Pixel cs e),
-                           Convertible (Pixel RGBA Word8) (Pixel cs e),
-                           Convertible (Pixel RGB Word16) (Pixel cs e),
-                           Convertible (Pixel RGBA Word16) (Pixel cs e),
-                           Convertible (Pixel RGB Float) (Pixel cs e),
-                           Convertible (Pixel YCbCr Word8) (Pixel cs e),
-                           Convertible (Pixel CMYK Word8) (Pixel cs e),
-                           Convertible (Pixel CMYK Word16) (Pixel cs e),
-                           Array VS cs e) =>
-                          JP.DynamicImage -> Image VS cs e
-jpDynamicImageToImage' (JP.ImageY8 jimg)     =
-  I.map convert $ (jpImageToImageUnsafe jimg :: Image VS Y Word8)
-jpDynamicImageToImage' (JP.ImageYA8 jimg)    =
-  I.map convert $ (jpImageToImageUnsafe jimg :: Image VS YA Word8)
-jpDynamicImageToImage' (JP.ImageY16 jimg)    =
-  I.map convert $ (jpImageToImageUnsafe jimg :: Image VS Y Word16)
-jpDynamicImageToImage' (JP.ImageYA16 jimg)   =
-  I.map convert $ (jpImageToImageUnsafe jimg :: Image VS YA Word16)
-jpDynamicImageToImage' (JP.ImageYF jimg)     =
-  I.map convert $ (jpImageToImageUnsafe jimg :: Image VS Y Float)
-jpDynamicImageToImage' (JP.ImageRGB8 jimg)   =
-  I.map convert $ (jpImageToImageUnsafe jimg :: Image VS RGB Word8)
-jpDynamicImageToImage' (JP.ImageRGBA8 jimg)  =
-  I.map convert $ (jpImageToImageUnsafe jimg :: Image VS RGBA Word8)
-jpDynamicImageToImage' (JP.ImageRGB16 jimg)  =
-  I.map convert $ (jpImageToImageUnsafe jimg :: Image VS RGB Word16)
-jpDynamicImageToImage' (JP.ImageRGBA16 jimg) =
-  I.map convert $ (jpImageToImageUnsafe jimg :: Image VS RGBA Word16)
-jpDynamicImageToImage' (JP.ImageRGBF jimg)   =
-  I.map convert $ (jpImageToImageUnsafe jimg :: Image VS RGB Float)
-jpDynamicImageToImage' (JP.ImageYCbCr8 jimg) =
-  I.map convert $ (jpImageToImageUnsafe jimg :: Image VS YCbCr Word8)
-jpDynamicImageToImage' (JP.ImageCMYK8 jimg)  =
-  I.map convert $ (jpImageToImageUnsafe jimg :: Image VS CMYK Word8)
-jpDynamicImageToImage' (JP.ImageCMYK16 jimg) =
-  I.map convert $ (jpImageToImageUnsafe jimg :: Image VS CMYK Word16)
-
-
-jpDynamicImageToImage :: (Convertible (Pixel Y Word8) (Pixel cs e),
-                          Convertible (Pixel YA Word8) (Pixel cs e),
-                          Convertible (Pixel Y Word16) (Pixel cs e),
-                          Convertible (Pixel YA Word16) (Pixel cs e),
-                          Convertible (Pixel Y Float) (Pixel cs e),
-                          Convertible (Pixel RGB Word8) (Pixel cs e),
-                          Convertible (Pixel RGBA Word8) (Pixel cs e),
-                          Convertible (Pixel RGB Word16) (Pixel cs e),
-                          Convertible (Pixel RGBA Word16) (Pixel cs e),
-                          Convertible (Pixel RGB Float) (Pixel cs e),
-                          Convertible (Pixel YCbCr Word8) (Pixel cs e),
-                          Convertible (Pixel CMYK Word8) (Pixel cs e),
-                          Convertible (Pixel CMYK Word16) (Pixel cs e),
-                          Array VS cs e) =>
-                         Either String JP.DynamicImage -> Either String (Image VS cs e)
-jpDynamicImageToImage = either jpError (Right . jpDynamicImageToImage')
-
-
-jpImageShowCS :: JP.DynamicImage -> String
-jpImageShowCS (JP.ImageY8 _)     = "Y8 (Pixel Y Word8)"
-jpImageShowCS (JP.ImageY16 _)    = "Y16 (Pixel Y Word16)"
-jpImageShowCS (JP.ImageYF _)     = "YF (Pixel Y Float)"
-jpImageShowCS (JP.ImageYA8 _)    = "YA8 (Pixel YA Word8)"
-jpImageShowCS (JP.ImageYA16 _)   = "YA16 (Pixel YA Word16)"
-jpImageShowCS (JP.ImageRGB8 _)   = "RGB8 (Pixel RGB Word8)"
-jpImageShowCS (JP.ImageRGB16 _)  = "RGB16 (Pixel RGB Word16)"
-jpImageShowCS (JP.ImageRGBF _)   = "RGBF (Pixel RGB Float)"
-jpImageShowCS (JP.ImageRGBA8 _)  = "RGBA8 (Pixel RGBA Word8)"
-jpImageShowCS (JP.ImageRGBA16 _) = "RGBA16 (Pixel RGBA Word16)"
-jpImageShowCS (JP.ImageYCbCr8 _) = "YCbCr8 (Pixel YCbCr Word8)"
-jpImageShowCS (JP.ImageCMYK8 _)  = "CMYK8 (Pixel CMYK Word8)"
-jpImageShowCS (JP.ImageCMYK16 _) = "CMYK16 (Pixel CMYK Word16)"
-
-
-jpError :: String -> Either String a
-jpError err = Left ("JuicyPixel decoding error: "++err)
-
-
-jpCSError :: String -> Either String JP.DynamicImage -> Either String a
-jpCSError _  (Left err)   = jpError err
-jpCSError cs (Right jimg) =
-  jpError $
-  "Input image is in " ++
-  jpImageShowCS jimg ++ ", cannot convert it to " ++ cs ++ " colorspace."
diff --git a/src/Graphics/Image/IO/Formats/JuicyPixels/Writable.hs b/src/Graphics/Image/IO/Formats/JuicyPixels/Writable.hs
deleted file mode 100644
--- a/src/Graphics/Image/IO/Formats/JuicyPixels/Writable.hs
+++ /dev/null
@@ -1,305 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE ViewPatterns #-}
--- |
--- Module      : Graphics.Image.IO.Formats.JuicyPixels.Writable
--- Copyright   : (c) Alexey Kuleshevich 2017
--- License     : BSD3
--- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
--- Stability   : experimental
--- Portability : non-portable
---
-module Graphics.Image.IO.Formats.JuicyPixels.Writable () where
-
-import Prelude as P
-import qualified Data.Monoid as M (mempty)
-import Graphics.Image.ColorSpace
-import Graphics.Image.Interface as I
-import Graphics.Image.Interface.Vector
-import Graphics.Image.IO.Base
-import Graphics.Image.IO.Formats.JuicyPixels.Common
-import qualified Data.ByteString.Lazy as BL (ByteString)
-import qualified Codec.Picture as JP
-import qualified Codec.Picture.Jpg as JP
-import qualified Codec.Picture.ColorQuant as JP
-import qualified Data.Vector.Storable as V
-
---------------------------------------------------------------------------------
--- Encoding images using JuicyPixels -------------------------------------------
---------------------------------------------------------------------------------
-
-instance Writable (Image VS Y Word8) BMP where
-  encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.Pixel8) id
-
-instance Writable (Image VS RGB Word8) BMP where
-  encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.PixelRGB8) id
-
-instance Writable (Image VS RGBA Word8) BMP where
-  encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.PixelRGBA8) id
-
-instance Writable (Image VS Binary Bit) BMP where
-  encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.Pixel8) fromPixelBinary
-
-instance Writable (Image VS Y Double) BMP where
-  encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.Pixel8) (fmap toWord8)
-
-instance Writable (Image VS YA Double) BMP where
-  encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.Pixel8)
-                                                ((fmap toWord8) . dropAlpha)
-
-instance Writable (Image VS RGB Double) BMP where
-  encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.PixelRGB8) (fmap toWord8)
-
-instance Writable (Image VS RGBA Double) BMP where
-  encode _ _ = JP.encodeBitmap . imageToJPImage (undefined :: JP.PixelRGBA8) (fmap toWord8)
-
--- Writable GIF
-
-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 (undefined :: JP.PixelRGB8) conv
-encodeGIF (GIFPalette palOpts:_) !conv =
-  either error id . uncurry JP.encodeGifImageWithPalette .
-  JP.palettize palOpts . imageToJPImage (undefined :: JP.PixelRGB8) conv
-
-
-instance Writable (Image VS RGB Word8) GIF where
-  encode _ opts = encodeGIF opts id
-  
-instance Writable (Image VS Y Double) GIF where
-  encode _ opts = encodeGIF opts ((fmap toWord8) . toPixelRGB)
-    
-instance Writable (Image VS YA Double) GIF where
-  encode _ opts = encodeGIF opts ((fmap toWord8) . toPixelRGB . dropAlpha)
-
-instance Writable (Image VS RGB Double) GIF where
-  encode _ opts = encodeGIF opts (fmap toWord8)
-
-instance Writable (Image VS RGBA Double) GIF where
-  encode _ opts = encodeGIF opts ((fmap toWord8) . dropAlpha)
-
-
-encodeGIFA :: (Array VS cs' e, Array VS cs Word8) =>
-              [SaveOption GIFA] -> (Pixel cs' e -> Pixel cs Word8)
-           -> [(JP.GifDelay, Image VS cs' e)] -> BL.ByteString
-encodeGIFA !opts !conv =
-  either error id . JP.encodeGifImages (getGIFALoop opts) . P.map palletizeGif where
-    getGIFALoop []                   = JP.LoopingNever
-    getGIFALoop (GIFALooping loop:_) = loop
-    getGIFALoop (_:xs)               = getGIFALoop xs    
-    getGIFAPal []                      = JP.defaultPaletteOptions
-    getGIFAPal (GIFAPalette palOpts:_) = palOpts
-    getGIFAPal (_:xs)                  = getGIFAPal xs
-    palletizeGif !(d, img) = (p, d, jimg) where  
-      !(jimg, p) = JP.palettize (getGIFAPal opts) $
-                   imageToJPImage (undefined :: JP.PixelRGB8) conv img
-
-
-instance Writable [(JP.GifDelay, Image VS RGB Word8)] GIFA where
-  encode _ opts = encodeGIFA opts id
-
-instance Writable [(JP.GifDelay, Image VS RGB Double)] GIFA where
-  encode _ opts = encodeGIFA opts (fmap toWord8)
-
--- Writable HDR
-
-instance Writable (Image VS RGB Float) HDR where
-  encode _ _ = JP.encodeHDR . imageToJPImage (undefined :: JP.PixelRGBF) id
-
-instance Writable (Image VS Y Double) HDR where
-  encode _ _ = JP.encodeHDR . imageToJPImage (undefined :: JP.PixelRGBF)
-                                             (fmap toFloat . toPixelRGB)
-
-instance Writable (Image VS YA Double) HDR where
-  encode _ _ = JP.encodeHDR . imageToJPImage (undefined :: JP.PixelRGBF)
-                                             (fmap toFloat . toPixelRGB . dropAlpha)
-
-instance Writable (Image VS RGB Double) HDR where
-  encode _ _ = JP.encodeHDR . imageToJPImage (undefined :: JP.PixelRGBF) (fmap toFloat)
-
-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 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 Writable (Image VS Y Word8) JPG where
-  encode _ opts = encodeJPG opts (undefined :: JP.Pixel8) id
-
-instance Writable (Image VS RGB Word8) JPG where
-  encode _ opts = encodeJPG opts (undefined :: JP.PixelRGB8) id
-
-instance Writable (Image VS CMYK Word8) JPG where
-  encode _ opts = encodeJPG opts (undefined :: JP.PixelCMYK8) id
-               
-instance Writable (Image VS YCbCr Word8) JPG where
-  encode _ opts = encodeJPG opts (undefined :: JP.PixelYCbCr8) id
-
-instance Writable (Image VS Y Double) JPG where
-  encode _ opts = encodeJPG opts (undefined :: JP.Pixel8) (fmap toWord8)
-
-instance Writable (Image VS YA Double) JPG where
-  encode _ opts = encodeJPG opts (undefined :: JP.Pixel8) ((fmap toWord8) . dropAlpha) 
-
-instance Writable (Image VS RGB Double) JPG where
-  encode _ opts = encodeJPG opts (undefined :: JP.PixelRGB8) (fmap toWord8)
-
-instance Writable (Image VS RGBA Double) JPG where
-  encode _ opts = encodeJPG opts (undefined :: JP.PixelRGB8) ((fmap toWord8) . dropAlpha) 
-
-
--- Writable PNG
-
-instance Writable (Image VS Binary Bit) PNG where
-  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.Pixel8) fromPixelBinary
-  
-instance Writable (Image VS Y Word8) PNG where
-  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.Pixel8) id
-
-instance Writable (Image VS Y Word16) PNG where
-  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.Pixel16) id
-
-instance Writable (Image VS YA Word8) PNG where
-  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelYA8) id
-
-instance Writable (Image VS YA Word16) PNG where
-  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelYA16) id
-
-instance Writable (Image VS RGB Word8) PNG where
-  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelRGB8) id
-
-instance Writable (Image VS RGB Word16) PNG where
-  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelRGB16) id
-
-instance Writable (Image VS RGBA Word8) PNG where
-  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelRGBA8) id
-
-instance Writable (Image VS RGBA Word16) PNG where
-  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelRGBA16) id
-
-
-instance Writable (Image VS Y Double) PNG where
-  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.Pixel16) (fmap toWord16)
-
-instance Writable (Image VS YA Double) PNG where
-  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelYA16) (fmap toWord16)
-
-instance Writable (Image VS RGB Double) PNG where
-  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelRGB16) (fmap toWord16)
-
-instance Writable (Image VS RGBA Double) PNG where
-  encode _ _ = JP.encodePng . imageToJPImage (undefined :: JP.PixelRGBA16) (fmap toWord16)
-
--- Writable TGA
-
-instance Writable (Image VS Binary Bit) TGA where
-  encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.Pixel8) fromPixelBinary
-  
-instance Writable (Image VS Y Word8) TGA where
-  encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.Pixel8) id
-
-instance Writable (Image VS RGB Word8) TGA where
-  encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.PixelRGB8) id
-
-instance Writable (Image VS RGBA Word8) TGA where
-  encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.PixelRGBA8) id
-
-
-instance Writable (Image VS Y Double) TGA where
-  encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.Pixel8) (fmap toWord8)
-
-instance Writable (Image VS YA Double) TGA where
-  encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.Pixel8) ((fmap toWord8) . dropAlpha)
-
-instance Writable (Image VS RGB Double) TGA where
-  encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.PixelRGB8) (fmap toWord8)
-
-instance Writable (Image VS RGBA Double) TGA where
-  encode _ _ = JP.encodeTga . imageToJPImage (undefined :: JP.PixelRGBA8) (fmap toWord8)
-
--- Writable TIF
-
-instance Writable (Image VS Y Word8) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.Pixel8) id
-
-instance Writable (Image VS Y Word16) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.Pixel16) id
-
-instance Writable (Image VS YA Word8) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelYA8) id
-
-instance Writable (Image VS YA Word16) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelYA16) id
-
-instance Writable (Image VS RGB Word8) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelRGB8) id
-
-instance Writable (Image VS RGB Word16) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelRGB16) id
-
-instance Writable (Image VS RGBA Word8) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelRGBA8) id
-
-instance Writable (Image VS RGBA Word16) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelRGBA16) id
-
-instance Writable (Image VS YCbCr Word8) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelYCbCr8) id
-  
-instance Writable (Image VS CMYK Word8) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelCMYK8) id
-
-instance Writable (Image VS CMYK Word16) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelCMYK16) id
-
-
-instance Writable (Image VS Binary Bit) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.Pixel8) fromPixelBinary
-  
-instance Writable (Image VS Y Double) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.Pixel16) (fmap toWord16)
-
-instance Writable (Image VS YA Double) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelYA16) (fmap toWord16)
-
-instance Writable (Image VS RGB Double) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelRGB16) (fmap toWord16)
-
-instance Writable (Image VS RGBA Double) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelRGBA16) (fmap toWord16)
-
-instance Writable (Image VS YCbCr Double) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelYCbCr8) (fmap toWord8)
-
-instance Writable (Image VS CMYK Double) TIF where
-  encode _ _ = JP.encodeTiff . imageToJPImage (undefined :: JP.PixelCMYK16) (fmap toWord16)
-
-
-
-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 $ toVector $ I.map f img where
-  !(m, n) = dims img
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
@@ -1,32 +1,37 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeFamilies          #-}
 -- |
 -- Module      : Graphics.Image.IO.Formats.Netpbm
--- 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.IO.Formats.Netpbm (
-  PBM(..), PGM(..), PPM(..)
+module Graphics.Image.IO.Formats.Netpbm
+  ( -- * Netpbm formats
+    -- ** PBM
+    PBM(..)
+    -- ** PGM
+  , PGM(..)
+    -- ** PPM
+  , PPM(..)
   ) where
 
-import Graphics.Image.ColorSpace
-import Graphics.Image.Interface as I
-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 V
+import qualified Data.ByteString                 as B (ByteString)
+import qualified Data.Vector.Storable            as V
+import           Foreign.Storable                (Storable)
+import           Graphics.Image.ColorSpace
+import           Graphics.Image.Interface        as I
+import           Graphics.Image.Interface.Vector (VS)
+import           Graphics.Image.IO.Base
+import qualified Graphics.Netpbm                 as PNM
 
 
 -- | Netpbm: portable bitmap image with @.pbm@ extension.
-data PBM = PBM
+data PBM = PBM deriving Show
 
 instance ImageFormat PBM where
   data SaveOption PBM
@@ -35,7 +40,7 @@
 
 
 -- | Netpbm: portable graymap image with @.pgm@ extension.
-data PGM = PGM
+data PGM = PGM deriving Show
 
 instance ImageFormat PGM where
   data SaveOption PGM
@@ -44,7 +49,7 @@
 
 
 -- | Netpbm: portable pixmap image with @.ppm@ extension.
-data PPM = PPM
+data PPM = PPM deriving Show
 
 instance ImageFormat PPM where
   data SaveOption PPM
@@ -52,55 +57,29 @@
   ext _ = ".ppm"
 
 
-instance ImageFormat [PBM] where
-  data SaveOption [PBM]
+instance ImageFormat (Seq PBM) where
+  data SaveOption (Seq PBM)
 
   ext _ = ".pbm"
 
 
-instance ImageFormat [PGM] where
-  data SaveOption [PGM]
+instance ImageFormat (Seq PGM) where
+  data SaveOption (Seq PGM)
 
   ext _ = ".pgm"
 
 
-instance ImageFormat [PPM] where
-  data SaveOption [PPM]
+instance ImageFormat (Seq PPM) where
+  data SaveOption (Seq PPM)
 
   ext _ = ".ppm"
 
 
 --------------------------------------------------------------------------------
--- Converting to and from Netpbm -----------------------------------------------
---------------------------------------------------------------------------------
-
-
----- Exact precision conversions
-
-
-instance Convertible PNM.PbmPixel (Pixel Binary Bit) where
-  convert (PNM.PbmPixel bool) = fromBool bool
-  
-instance Convertible PNM.PgmPixel8 (Pixel Y Word8) where
-  convert (PNM.PgmPixel8 w8) = PixelY w8
-
-instance Convertible PNM.PgmPixel16 (Pixel Y Word16) where
-  convert (PNM.PgmPixel16 w16) = PixelY w16
-
-instance Convertible PNM.PpmPixelRGB8 (Pixel RGB Word8) where
-  convert (PNM.PpmPixelRGB8 r g b) = PixelRGB r g b
-
-instance Convertible PNM.PpmPixelRGB16 (Pixel RGB Word16) where
-  convert (PNM.PpmPixelRGB16 r g b) = PixelRGB r g b
-
-
---------------------------------------------------------------------------------
 -- Decoding images using Netpbm ------------------------------------------------
 --------------------------------------------------------------------------------
 
 
--- BPM Format Reading (general)
-
 instance Readable (Image VS Y Double) PBM where
   decode _ = fmap (ppmToImageUsing pnmDataToImage . head) . decodePnm
 
@@ -119,9 +98,8 @@
 instance Readable (Image VS RGBA Double) PPM where
   decode _ = fmap (ppmToImageUsing pnmDataToImage . head) . decodePnm
 
--- BPM Format Reading (exact)
 
-instance Readable (Image VS Binary Bit) PBM where
+instance Readable (Image VS X Bit) PBM where
   decode _ = either Left (ppmToImageUsing pnmDataPBMToImage . head) . decodePnm
 
 instance Readable (Image VS Y Word8) PGM where
@@ -137,19 +115,19 @@
   decode _ = either Left (ppmToImageUsing pnmDataPPM16ToImage . head) . decodePnm
 
 
-instance Readable [Image VS Binary Bit] [PBM] where
+instance Readable [Image VS X Bit] (Seq PBM) where
   decode _ = pnmToImagesUsing pnmDataPBMToImage
 
-instance Readable [Image VS Y Word8] [PGM] where
+instance Readable [Image VS Y Word8] (Seq PGM) where
   decode _ = pnmToImagesUsing pnmDataPGM8ToImage
 
-instance Readable [Image VS Y Word16] [PGM] where
+instance Readable [Image VS Y Word16] (Seq PGM) where
   decode _ = pnmToImagesUsing pnmDataPGM16ToImage
 
-instance Readable [Image VS RGB Word8] [PPM] where
+instance Readable [Image VS RGB Word8] (Seq PPM) where
   decode _ = pnmToImagesUsing pnmDataPPM8ToImage
 
-instance Readable [Image VS RGB Word16] [PPM] where
+instance Readable [Image VS RGB Word16] (Seq PPM) where
   decode _ = pnmToImagesUsing pnmDataPPM16ToImage
 
 
@@ -159,23 +137,19 @@
   fmap (fmap (either error id . ppmToImageUsing conv)) . decodePnm
 
 
-pnmDataToImage :: (Convertible (Pixel Binary Bit) (Pixel cs e),
-                   Convertible (Pixel Y Word8) (Pixel cs e),
-                   Convertible (Pixel Y Word16) (Pixel cs e),
-                   Convertible (Pixel RGB Word8) (Pixel cs e),
-                   Convertible (Pixel RGB Word16) (Pixel cs e),
-                   Array VS cs e) =>
-                  Int -> Int -> PNM.PpmPixelData -> Image VS cs e
+pnmDataToImage
+  :: (Convertible cs e, ColorSpace cs e, V.Storable (Pixel cs e)) =>
+     Int -> Int -> PNM.PpmPixelData -> Image VS cs e
 pnmDataToImage w h (PNM.PbmPixelData v)      =
-  I.map convert (makeImageUnsafe (h, w) v :: Image VS Binary Bit)
+  convert (makeImageUnsafe (h, w) v :: Image VS X Bit)
 pnmDataToImage w h (PNM.PgmPixelData8 v)     =
-  I.map convert (makeImageUnsafe (h, w) v :: Image VS Y Word8)
+  convert (makeImageUnsafe (h, w) v :: Image VS Y Word8)
 pnmDataToImage w h (PNM.PgmPixelData16 v)    =
-  I.map convert (makeImageUnsafe (h, w) v :: Image VS Y Word16)
+  convert (makeImageUnsafe (h, w) v :: Image VS Y Word16)
 pnmDataToImage w h (PNM.PpmPixelDataRGB8 v)  =
-  I.map convert (makeImageUnsafe (h, w) v :: Image VS RGB Word8)
+  convert (makeImageUnsafe (h, w) v :: Image VS RGB Word8)
 pnmDataToImage w h (PNM.PpmPixelDataRGB16 v) =
-  I.map convert (makeImageUnsafe (h, w) v :: Image VS RGB Word16)
+  convert (makeImageUnsafe (h, w) v :: Image VS RGB Word16)
 
 
 makeImageUnsafe
@@ -184,9 +158,9 @@
 makeImageUnsafe sz = fromVector sz . V.unsafeCast
 
 
-pnmDataPBMToImage :: Int -> Int -> PNM.PpmPixelData -> Either String (Image VS Binary Bit)
+pnmDataPBMToImage :: Int -> Int -> PNM.PpmPixelData -> Either String (Image VS X Bit)
 pnmDataPBMToImage w h (PNM.PbmPixelData v) = Right $ makeImageUnsafe (h, w) v
-pnmDataPBMToImage _ _ d                    = pnmCSError "Binary (Pixel Binary Bit)" d
+pnmDataPBMToImage _ _ d                    = pnmCSError "Binary (Pixel X Bit)" d
 
 pnmDataPGM8ToImage :: Int -> Int -> PNM.PpmPixelData -> Either String (Image VS Y Word8)
 pnmDataPGM8ToImage w h (PNM.PgmPixelData8 v) = Right $ makeImageUnsafe (h, w) v
@@ -209,8 +183,8 @@
 ppmToImageUsing conv PNM.PPM {PNM.ppmHeader = PNM.PPMHeader {PNM.ppmWidth = w
                                                             ,PNM.ppmHeight = h}
                              ,PNM.ppmData = ppmData} = conv w h ppmData
-                                                        
 
+
 decodePnm :: B.ByteString -> Either String [PNM.PPM]
 decodePnm = pnmResultToImage . PNM.parsePPM where
   pnmResultToImage (Right ([], _))   = pnmError "Unknown"
@@ -229,7 +203,7 @@
   pnmShowData ppmData ++ ", cannot convert it to " ++ cs ++ " colorspace."
 
 pnmShowData :: PNM.PpmPixelData -> String
-pnmShowData (PNM.PbmPixelData _)      = "Binary (Pixel Binary Bit)"
+pnmShowData (PNM.PbmPixelData _)      = "Binary (Pixel X Bit)"
 pnmShowData (PNM.PgmPixelData8 _)     = "Y8 (Pixel Y Word8)"
 pnmShowData (PNM.PgmPixelData16 _)    = "Y16 (Pixel Y Word16)"
 pnmShowData (PNM.PpmPixelDataRGB8 _)  = "RGB8 (Pixel RGB Word8)"
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
@@ -1,10 +1,10 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE BangPatterns        #-}
+{-# LANGUAGE CPP                 #-}
+{-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE ViewPatterns #-}
 -- |
 -- Module      : Graphics.Image.IO.Histogram
--- Copyright   : (c) Alexey Kuleshevich 2016
+-- Copyright   : (c) Alexey Kuleshevich 2017
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -12,30 +12,31 @@
 --
 module Graphics.Image.IO.Histogram (
   Histogram(..), Histograms, ChannelColour(..), getHistograms, getHistogram,
+  equalizeHistogram, cdf,
   displayHistograms, writeHistograms
   ) where
 
-import Prelude as P 
-import Control.Concurrent (forkIO)
-import Control.Monad (void)
-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           Control.Concurrent                        (forkIO)
+import           Control.Monad                             (void)
+import qualified Data.Colour                               as C
+import qualified Data.Colour.Names                         as C
+import qualified Data.Vector.Unboxed                       as V
+import           Prelude                                   as P
+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
+import           Graphics.Image.ColorSpace
+import           Graphics.Image.Interface                  as I
+import           Graphics.Image.IO
+import           Graphics.Rendering.Chart.Backend.Diagrams
+import           Graphics.Rendering.Chart.Easy
 
 #if MIN_VERSION_vector(0,11,0)
-import Data.Vector.Unboxed.Mutable (modify)
+import           Data.Vector.Unboxed.Mutable               (modify)
 #else
-import Control.Monad.Primitive (PrimMonad (..))
-import qualified Data.Vector.Unboxed.Mutable as MV
+import           Control.Monad.Primitive                   (PrimMonad (..))
+import qualified Data.Vector.Unboxed.Mutable               as MV
 
 modify :: (PrimMonad m, V.Unbox a) => MV.MVector (PrimState m) a -> (a -> a) -> Int -> m ()
 modify v f idx = do
@@ -45,16 +46,16 @@
 
 
 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
+data Histogram = Histogram { hBins   :: V.Vector Int
                              -- ^ Vector containing pixel counts. Index of a
                              -- vector serves as an original pixel value.
-                           , hName :: String
+                           , hName   :: String
                              -- ^ Name of the channel that will be displayed in
                              -- the legend.
                            , hColour :: C.AlphaColour Double
@@ -64,28 +65,71 @@
 -- data type with fields like title, width, heigth, etc.
 type Histograms = [Histogram]
 
+
 -- | Create a histogram per channel with 256 bins each.
-getHistograms :: forall arr cs e . (ChannelColour cs, MArray arr X e, Array arr X e, 
+getHistograms :: forall arr cs e . (ChannelColour cs, MArray arr X e, Array arr X 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 . toImagesX
-  where setCh cs h = h { hName = show cs
-                       , hColour = csColour cs }
+  where setCh !cs !h = h { hName = show cs
+                         , hColour = csColour cs }
+        {-# INLINE setCh #-}
+{-# INLINE getHistograms #-}
 
 -- | Generate a histogram with 256 bins for a single channel Gray image.
 getHistogram :: MArray arr X e =>
                 Image arr X e
              -> Histogram
-getHistogram img = Histogram { hBins = V.modify countBins $
-                                       V.replicate
-                                       (1 + fromIntegral (maxBound :: Word8)) (0 :: Int)
-                             , hName = show X
-                             , hColour = csColour X } where
-  incBin v (PixelX g) = modify v (+1) $ fromIntegral (toWord8 g)
-  countBins v = I.mapM_ (incBin v) img
-  
+getHistogram !img = Histogram { hBins = V.modify countBins $
+                                        V.replicate
+                                        (1 + fromIntegral (maxBound :: Word8)) (0 :: Int)
+                              , hName = show X
+                              , hColour = csColour X }
+  where
+    incBin !v (PixelX x) = modify v (+1) $ fromIntegral (toWord8 x)
+    {-# INLINE incBin #-}
+    countBins !v = I.mapM_ (incBin v) img
+    {-# INLINE countBins #-}
+{-# INLINE getHistogram #-}
 
+
+-- | Discrete cumulative distribution function.
+cdf :: MArray arr X e => Image arr X e -> V.Vector Double
+cdf !img = V.unfoldr gen (0, 0)
+  where
+    !p = 1 / fromIntegral (m * n)
+    !(m, n) = dims img
+    !histogram = hBins $ getHistogram img
+    !l = V.length histogram
+    gen !(acc, k)
+      | k == l = Nothing
+      | otherwise =
+        let !acc' = acc + fromIntegral (V.unsafeIndex histogram k)
+        in Just (acc' * p, (acc', k + 1))
+    {-# INLINE gen #-}
+{-# INLINE cdf #-}
+
+
+-- | Converts an image to Luma and performs histogram equalization.
+equalizeHistogram
+  :: ( ToY cs e
+     , Array arr cs e
+     , Array arr Y Double
+     , Array arr X Word8
+     , MArray arr X Word8
+     )
+  => Image arr cs e -> Image arr Y Double
+equalizeHistogram !img = I.map f imgX where
+  !imgX = I.map (toX . toPixelY) img
+  !cdfImg = cdf imgX
+  toX (PixelY y) = PixelX $ toWord8 y
+  {-# INLINE toX #-}
+  f (PixelX x) = PixelY (V.unsafeIndex cdfImg (fromIntegral x))
+  {-# INLINE f #-}
+{-# INLINE equalizeHistogram #-}
+
+
 -- | Write histograms into a PNG image file.
 --
 -- >>> frog <- readImageRGB VU "images/frog.jpg"
@@ -157,9 +201,9 @@
   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 HueHSIA   = C.opaque C.purple
+  csColour SatHSIA   = C.opaque C.orange
+  csColour IntHSIA   = C.opaque C.darkblue
   csColour AlphaHSIA = 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
@@ -1,17 +1,18 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE BangPatterns            #-}
+{-# LANGUAGE CPP                     #-}
+{-# LANGUAGE ConstraintKinds         #-}
+{-# LANGUAGE FlexibleContexts        #-}
+{-# LANGUAGE FlexibleInstances       #-}
+{-# LANGUAGE MultiParamTypeClasses   #-}
+{-# LANGUAGE Rank2Types              #-}
+{-# LANGUAGE ScopedTypeVariables     #-}
+{-# LANGUAGE TypeFamilies            #-}
+{-# LANGUAGE UndecidableInstances    #-}
+{-# LANGUAGE ViewPatterns            #-}
 #if __GLASGOW_HASKELL__ >= 800
     {-# OPTIONS_GHC -Wno-redundant-constraints #-}
-    {-# LANGUAGE UndecidableSuperClasses #-}
+{-# LANGUAGE UndecidableSuperClasses #-}
 #endif
-{-# LANGUAGE ViewPatterns #-}
 -- |
 -- Module      : Graphics.Image.Interface
 -- Copyright   : (c) Alexey Kuleshevich 2017
@@ -21,10 +22,17 @@
 -- Portability : non-portable
 --
 module Graphics.Image.Interface (
+  -- * Pixel and ColorSpace
   Pixel, ColorSpace(..), AlphaSpace(..), Elevator(..),
-  BaseArray(..), Array(..), MArray(..),
+  -- * Array and Image
+  BaseArray(..), Array(..),
+  -- * MArray and MImage
+  MArray(..), createImage,
+  -- * Exchanging Representation
   exchange,
-  defaultIndex, borderIndex, maybeIndex, Border(..), handleBorderIndex,
+  -- * Indexing
+  index, defaultIndex, borderIndex, maybeIndex, Border(..), handleBorderIndex,
+  -- * Tools
   fromIx, toIx, checkDims
 #if !MIN_VERSION_base(4,8,0)
   , module Control.Applicative
@@ -32,29 +40,33 @@
 #endif
   ) where
 
-import Prelude hiding (and, map, zipWith, sum, product)
+import           Prelude                           hiding (and, map, product,
+                                                    sum, zipWith)
 #if !MIN_VERSION_base(4,8,0)
-import Control.Applicative
+import           Control.Applicative
 #endif
-import Control.Monad.Primitive (PrimMonad (..))
-import Data.Maybe (fromMaybe)
-import Data.Foldable
-import GHC.Exts (Constraint)
-import Data.Typeable (Typeable, showsTypeRep, typeOf)
-import Control.DeepSeq (NFData(rnf), deepseq)
-import qualified Data.Vector.Generic as VG
-import qualified Data.Vector.Unboxed as VU
+import           Control.DeepSeq                   (NFData (rnf), deepseq)
+import           Control.Monad.Primitive           (PrimMonad (..))
+import           Control.Monad.ST
+import           Data.Foldable
+import           Data.Maybe                        (fromMaybe)
+import           Data.Proxy                        (Proxy (..))
+import           Data.Typeable                     (Typeable, showsTypeRep,
+                                                    typeRep)
+import qualified Data.Vector.Generic               as VG
+import qualified Data.Vector.Unboxed               as VU
+import           GHC.Exts                          (Constraint)
 
-import Graphics.Image.Interface.Elevator
+import           Graphics.Image.Interface.Elevator
 
 -- | A Pixel family with a color space and a precision of elements.
 data family Pixel cs e :: *
 
 
-class (Eq cs, Enum cs, Show cs, Bounded cs, Typeable cs, Elevator e,
-      Eq (Pixel cs e), VU.Unbox (Components cs e))
+class (Eq cs, Enum cs, Show cs, Bounded cs, Typeable cs,
+      Eq (Pixel cs e), VU.Unbox (Components cs e), Elevator e)
       => ColorSpace cs e where
-  
+
   type Components cs e
 
   -- | Convert a Pixel to a representation suitable for storage as an unboxed
@@ -69,12 +81,12 @@
 
   -- | Retrieve Pixel's component value
   getPxC :: Pixel cs e -> 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 
+  mapPxC :: (cs -> e -> e) -> Pixel cs e -> Pixel cs e
 
   -- | Map a function over all Pixel's componenets.
   liftPx :: (e -> e) -> Pixel cs e -> Pixel cs e
@@ -82,6 +94,7 @@
   -- | Zip two Pixels with a function.
   liftPx2 :: (e -> e -> e) -> Pixel cs e -> Pixel cs e -> Pixel cs e
 
+  -- | Left fold on two pixels a the same time.
   foldlPx2 :: (b -> e -> e -> b) -> b -> Pixel cs e -> Pixel cs e -> b
 
   -- | Right fold over all Pixel's components.
@@ -105,21 +118,21 @@
   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) 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. 
+  -- | Get an alpha channel of a transparant pixel.
   getAlpha :: Pixel cs e -> e
 
   -- | Add an alpha channel to an opaque pixel.
   --
   -- @ addAlpha 0 (PixelHSI 1 2 3) == PixelHSIA 1 2 3 0 @
   addAlpha :: e -> Pixel (Opaque cs) e -> Pixel cs e
-  
+
   -- | Convert a transparent pixel to an opaque one by dropping the alpha
   -- channel.
   --
@@ -164,7 +177,8 @@
             -> Image arr cs e
 
   makeImageWindowed :: (Int, Int) -- ^ (@m@ rows, @n@ columns) - dimensions of a new image.
-                    -> ((Int, Int), (Int, Int))
+                    -> (Int, Int) -- ^ Starting index
+                    -> (Int, Int) -- ^ Size of the window
                     -> ((Int, Int) -> Pixel cs e)
                        -- ^ Function that generates inner pixels.
                     -> ((Int, Int) -> Pixel cs e)
@@ -217,7 +231,7 @@
            -- function), a location @(i, j)@ in a new image and returns a pixel
            -- for that location.
            -> Image arr cs e
-  
+
   -- | Traverse two images.
   traverse2 :: (Array arr cs1 e1, Array arr cs2 e2) =>
                Image arr cs1 e1 -- ^ First source image.
@@ -229,11 +243,11 @@
                 (Int, Int) -> Pixel cs e)
             -- ^ Function that produces pixels for the new image.
             -> Image arr cs e
-  
+
   -- | Transpose an image
   transpose :: Image arr cs e -> Image arr cs e
 
-  -- | Backwards permutation of an image. 
+  -- | Backwards permutation of an image.
   backpermute :: (Int, Int) -- ^ Dimensions of a result image.
               -> ((Int, Int) -> (Int, Int))
                  -- ^ Function that maps an index of a source image to an index
@@ -256,7 +270,7 @@
   -- | 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.
@@ -274,14 +288,14 @@
   -- 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
   -- the 'Eq' typeclass.
-  eq :: Eq (Pixel cs e) => Image arr cs e -> Image arr cs e -> Bool
+  eq :: Image arr cs e -> Image arr cs e -> Bool
 
   -- | `Array` class does not enforce an image to be represented as concrete
   -- array of pixels in memory, but if at any time it is desired for the image
   -- to be brought to a computed state, this function can be used.
   compute :: Image arr cs e -> Image arr cs e
 
-  -- | Each array has a sibling `Manifest` array representation, which 
+  -- | Each array has a sibling `Manifest` array representation, which
   toManifest :: Image arr cs e -> Image (Manifest arr) cs e
 
   -- | Convert an image to a flattened 'Vector'. For all current representations
@@ -300,26 +314,17 @@
   -- <Image Vector Luma: 200x300>
   --
   -- <<images/grad_fromVector.png>>
-  -- 
+  --
   fromVector :: (Int, Int) -> Vector arr (Pixel cs e) -> Image arr cs e
 
-       
+
 -- | 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 s arr cs e
-  
+
+  -- | Get a pixel at @(i, j)@ location without any bounds checks.
   unsafeIndex :: Image arr cs e -> (Int, Int) -> Pixel cs e
-  
-  -- | Get a pixel at @i@-th and @j@-th location.
-  --
-  -- >>> let grad_gray = makeImage (200, 200) (\(i, j) -> PixelY $ fromIntegral (i*j)) / (200*200)
-  -- >>> index grad_gray (20, 30) == PixelY ((20*30) / (200*200))
-  -- True
-  --
-  index :: Image arr cs e -> (Int, Int) -> Pixel cs e
-  index !img !ix = borderIndex (error $ show img ++ " - Index out of bounds: " ++ show ix) img ix
-  {-# INLINE index #-}
 
   -- | Make sure that an image is fully evaluated.
   deepSeqImage :: Image arr cs e -> a -> a
@@ -380,6 +385,13 @@
           MImage (PrimState m) arr cs e -> (Int, Int) -> (Int, Int) -> m ()
 
 
+-- | Run a stateful monadic computation that generates an image.
+createImage
+  :: MArray arr cs e
+  => (forall s. ST s (MImage s arr cs e)) -> Image arr cs e
+createImage create = runST (create >>= freeze)
+
+
 -- | Exchange the underlying array representation of an image.
 exchange :: (Array arr' cs e, Array arr cs e) =>
             arr -- ^ New representation of an image.
@@ -387,12 +399,12 @@
          -> Image arr cs e
 exchange _ img@(dims -> (1, 1)) = scalar $ index00 img
 exchange _ img = fromVector (dims img) $ VG.convert $ toVector img
-{-# INLINE[0] exchange #-}
+{-# INLINE exchange #-}
 
 
-{-# RULES
-"exchange/id" forall arr. exchange arr = id
- #-}
+--{-# RULES
+--"exchange/id" forall arr. exchange arr = id
+-- #-}
 
 
 -- | Approach to be used near the borders during various transformations.
@@ -446,7 +458,7 @@
                    -> ((Int, Int) -> px) -- ^ Image's indexing function.
                    -> (Int, Int) -- ^ @(i, j)@ location of a pixel lookup.
                    -> px
-handleBorderIndex border !(m, n) getPx !(i, j) =
+handleBorderIndex ~border !(m, n) getPx !(i, j) =
   if north || east || south || west
   then case border of
     Fill px  -> px
@@ -470,6 +482,17 @@
 {-# INLINE handleBorderIndex #-}
 
 
+-- | Get a pixel at @i@-th and @j@-th location.
+--
+-- >>> let grad_gray = makeImage (200, 200) (\(i, j) -> PixelY $ fromIntegral (i*j)) / (200*200)
+-- >>> index grad_gray (20, 30) == PixelY ((20*30) / (200*200))
+-- True
+--
+index :: MArray arr cs e => Image arr cs e -> (Int, Int) -> Pixel cs e
+index !img !ix = borderIndex (error $ show img ++ " - Index out of bounds: " ++ show ix) img ix
+{-# INLINE index #-}
+
+
 -- | Image indexing function that returns a default pixel if index is out of bounds.
 defaultIndex :: MArray arr cs e =>
                 Pixel cs e -> Image arr cs e -> (Int, Int) -> Pixel cs e
@@ -481,7 +504,7 @@
 -- out of bounds pixels.
 borderIndex :: MArray arr cs e =>
                Border (Pixel cs e) -> Image arr cs e -> (Int, Int) -> Pixel cs e
-borderIndex atBorder !img = handleBorderIndex atBorder (dims img) (unsafeIndex img)
+borderIndex ~atBorder !img = handleBorderIndex atBorder (dims img) (unsafeIndex img)
 {-# INLINE borderIndex #-}
 
 
@@ -490,7 +513,7 @@
 maybeIndex :: MArray arr cs e =>
               Image arr cs e -> (Int, Int) -> Maybe (Pixel cs e)
 maybeIndex !img@(dims -> (m, n)) !(i, j) =
-  if i >= 0 && j >= 0 && i < m && j < n then Just $ index img (i, j) else Nothing
+  if i >= 0 && j >= 0 && i < m && j < n then Just $ unsafeIndex img (i, j) else Nothing
 {-# INLINE maybeIndex #-}
 
 
@@ -511,17 +534,16 @@
 toIx !n !k = divMod k n
 {-# INLINE toIx #-}
 
-
 checkDims :: String -> (Int, Int) -> (Int, Int)
-checkDims err !ds@(m, n)
-  | m <= 0 || n <= 0 = 
+checkDims err !sz@(m, n)
+  | m <= 0 || n <= 0 =
     error $
-    show err ++ ": Image dimensions are expected to be positive: " ++ show ds
-  | otherwise = ds
+    show err ++ ": dimensions are expected to be positive: " ++ show sz
+  | otherwise = sz
 {-# INLINE checkDims #-}
 
 
-instance (ColorSpace cs e, Num e) => Num (Pixel cs e) where
+instance ColorSpace cs e => Num (Pixel cs e) where
   (+)         = liftPx2 (+)
   {-# INLINE (+) #-}
   (-)         = liftPx2 (-)
@@ -534,8 +556,8 @@
   {-# INLINE signum #-}
   fromInteger = promote . fromInteger
   {-# INLINE fromInteger #-}
-  
 
+
 instance (ColorSpace cs e, Fractional e) => Fractional (Pixel cs e) where
   (/)          = liftPx2 (/)
   {-# INLINE (/) #-}
@@ -573,52 +595,40 @@
   acosh   = liftPx acosh
   {-# INLINE acosh #-}
 
-
 instance (ColorSpace cs e, Bounded e) => Bounded (Pixel cs e) where
   maxBound = promote maxBound
   {-# INLINE maxBound #-}
-  
   minBound = promote minBound
   {-# INLINE minBound #-}
 
-
 instance (Foldable (Pixel cs), NFData e) => NFData (Pixel cs e) where
 
   rnf = foldr' deepseq ()
   {-# INLINE rnf #-}
 
-
-instance (Array arr cs e, Eq (Pixel cs e)) => Eq (Image arr cs e) where
+instance Array arr cs e => Eq (Image arr cs e) where
   (==) = eq
   {-# INLINE (==) #-}
 
-  
 instance Array arr cs e => Num (Image arr cs e) where
   (+)         = zipWith (+)
   {-# INLINE (+) #-}
-  
   (-)         = zipWith (-)
   {-# INLINE (-) #-}
-  
   (*)         = zipWith (*)
   {-# INLINE (*) #-}
-  
   abs         = map abs
   {-# INLINE abs #-}
-  
   signum      = map signum
   {-# INLINE signum #-}
-  
   fromInteger = scalar . fromInteger
   {-# INLINE fromInteger #-}
 
-
 instance (Fractional (Pixel cs e), Array arr cs e) =>
          Fractional (Image arr cs e) where
   (/)          = zipWith (/)
   {-# INLINE (/) #-}
-  
-  fromRational = scalar . fromRational 
+  fromRational = scalar . fromRational
   {-# INLINE fromRational #-}
 
 
@@ -626,42 +636,30 @@
          Floating (Image arr cs e) where
   pi    = scalar pi
   {-# INLINE pi #-}
-  
   exp   = map exp
   {-# INLINE exp #-}
-  
   log   = map log
   {-# INLINE log #-}
-  
   sin   = map sin
   {-# INLINE sin #-}
-  
   cos   = map cos
   {-# INLINE cos #-}
-  
   asin  = map asin
   {-# INLINE asin #-}
-  
   atan  = map atan
   {-# INLINE atan #-}
-  
   acos  = map acos
   {-# INLINE acos #-}
-  
   sinh  = map sinh
   {-# INLINE sinh #-}
-  
   cosh  = map cosh
   {-# INLINE cosh #-}
-  
   asinh = map asinh
   {-# INLINE asinh #-}
-  
   atanh = map atanh
   {-# INLINE atanh #-}
-  
   acosh = map acosh
-  {-# INLINE acosh #-}  
+  {-# INLINE acosh #-}
 
 
 instance MArray arr cs e => NFData (Image arr cs e) where
@@ -669,14 +667,13 @@
   {-# INLINE rnf #-}
 
 
-
 instance BaseArray arr cs e =>
          Show (Image arr cs e) where
   show (dims -> (m, n)) =
     "<Image " ++
-    showsTypeRep (typeOf (undefined :: arr)) " " ++
-    showsTypeRep (typeOf (undefined :: cs)) " (" ++
-    showsTypeRep (typeOf (undefined :: e)) "): " ++
+    showsTypeRep (typeRep (Proxy :: Proxy arr)) " " ++
+    showsTypeRep (typeRep (Proxy :: Proxy cs)) " (" ++
+    showsTypeRep (typeRep (Proxy :: Proxy e)) "): " ++
      show m ++ "x" ++ show n ++ ">"
 
 
@@ -684,7 +681,7 @@
          Show (MImage st arr cs e) where
   show (mdims -> (m, n)) =
     "<MutableImage " ++
-    showsTypeRep (typeOf (undefined :: arr)) " " ++
-    showsTypeRep (typeOf (undefined :: cs)) " (" ++
-    showsTypeRep (typeOf (undefined :: e)) "): " ++
+    showsTypeRep (typeRep (Proxy :: Proxy arr)) " " ++
+    showsTypeRep (typeRep (Proxy :: Proxy cs)) " (" ++
+    showsTypeRep (typeRep (Proxy :: Proxy e)) "): " ++
      show m ++ "x" ++ show n ++ ">"
diff --git a/src/Graphics/Image/Interface/Elevator.hs b/src/Graphics/Image/Interface/Elevator.hs
--- a/src/Graphics/Image/Interface/Elevator.hs
+++ b/src/Graphics/Image/Interface/Elevator.hs
@@ -1,6 +1,6 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns        #-}
+{-# LANGUAGE CPP                 #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 #if __GLASGOW_HASKELL__ >= 800
   {-# OPTIONS_GHC -Wno-redundant-constraints #-}
@@ -15,14 +15,15 @@
 --
 module Graphics.Image.Interface.Elevator (
   Elevator(..)
+  , clamp01
   ) where
 
-import qualified Data.Complex as C
-import Data.Int
-import Data.Word
-import GHC.Float
-import Data.Typeable
-import Data.Vector.Unboxed (Unbox)
+import qualified Data.Complex        as C
+import           Data.Int
+import           Data.Typeable
+import           Data.Vector.Unboxed (Unbox)
+import           Data.Word
+import           GHC.Float
 
 
 -- | A class with a set of convenient functions that allow for changing precision of
@@ -61,7 +62,7 @@
 -- | Lower the precision
 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)) 
+                                                   fromIntegral (maxBound :: b))
 {-# INLINE dropDown #-}
 
 -- | Increase the precision
@@ -77,6 +78,7 @@
 -- | Convert to integral streaching it's value up to a maximum value.
 stretch :: forall a b. (RealFrac a, Floating a, Integral b, Bounded b) => a -> b
 stretch !e = round (fromIntegral (maxBound :: b) * clamp01 e)
+{-# INLINE stretch #-}
 
 
 -- | Clamp a value to @[0, 1]@ range.
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,3 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 -- |
@@ -30,12 +29,12 @@
 
 -- | Create a sequential unboxed image from a 2D Repa delayed array.
 fromRepaArrayS :: R.Source r (Pixel cs e) => R.Array r DIM2 (Pixel cs e) -> Image RSU cs e
-fromRepaArrayS = SUImage . SDImage . R.delay
+fromRepaArrayS = SUImage . fromRepaArrayR
 
 
 -- | Create a parallel unboxed image from a 2D Repa delayed array.
 fromRepaArrayP :: R.Source r (Pixel cs e) => R.Array r DIM2 (Pixel cs e) -> Image RPU cs e
-fromRepaArrayP = PUImage . PDImage . R.delay
+fromRepaArrayP = PUImage . fromRepaArrayR
 
 
 -- | Convert into Repa Unboxed array from an image.
diff --git a/src/Graphics/Image/Interface/Repa/Generic.hs b/src/Graphics/Image/Interface/Repa/Generic.hs
--- a/src/Graphics/Image/Interface/Repa/Generic.hs
+++ b/src/Graphics/Image/Interface/Repa/Generic.hs
@@ -1,14 +1,13 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE BangPatterns          #-}
+{-# LANGUAGE CPP                   #-}
+{-# LANGUAGE ConstraintKinds       #-}
+{-# LANGUAGE DeriveDataTypeable    #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE UndecidableInstances  #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 #if __GLASGOW_HASKELL__ >= 800
     {-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
@@ -21,498 +20,475 @@
 -- Stability   : experimental
 -- Portability : non-portable
 --
-module Graphics.Image.Interface.Repa.Generic where
+module Graphics.Image.Interface.Repa.Generic
+  ( RImage
+  , Strategy(..)
+  , computeR
+  , makeImageR
+  , dimsR
+  , scalarR
+  , index00R
+  , makeImageWindowedR
+  , mapR
+  , imapR
+  , eqR
+  , zipWithR
+  , izipWithR
+  , unsafeTraverseR
+  , traverseR
+  , unsafeTraverse2R
+  , traverse2R
+  , transposeR
+  , backpermuteR
+  , fromListsR
+  , foldR
+  , foldIxR
+  , toVectorUnboxedR
+  , fromVectorUnboxedR
+  , toVectorStorableR
+  , fromVectorStorableR
+  , fromRepaArrayR
+  , multR
+  , ix2sh
+  , sh2ix
+  )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.Vector.Generic as VG
-import Data.Typeable (Typeable)
+import           Data.Array.Repa                     as R
+import           Data.Array.Repa.Eval                as R (Elt (..), Target,
+                                                           fromList,
+                                                           suspendedComputeP)
+import           Data.Array.Repa.Operators.Traversal as R
+import           Data.Array.Repa.Repr.ForeignPtr
+import           Data.Array.Repa.Repr.Partitioned    (P, Range (..))
+import           Data.Array.Repa.Repr.Unboxed        (Unbox)
+import           Data.Array.Repa.Repr.Undefined      (X)
+import           Data.Complex                        as C
+import           Data.Maybe                          (listToMaybe)
+import qualified Data.Vector.Storable                as VS
+import qualified Data.Vector.Unboxed                 as VU
+import           Graphics.Image.ColorSpace.Binary    (Bit (..))
+import           Graphics.Image.Interface            (ColorSpace (..), Pixel,
+                                                      checkDims, toIx)
+import           Prelude                             as P
 
-import Graphics.Image.ColorSpace.Binary (Bit(..))
-import Graphics.Image.Interface as I
-import qualified Graphics.Image.Interface.Vector.Unboxed as IVU
-import Graphics.Image.Interface.Repa.Helpers
+data Strategy
+  = Parallel
+  | Sequential
 
+data RImage r p = RTImage !(R.Array r R.DIM2 p)
+                | RDImage !(R.Array R.D R.DIM2 p)
 
-type family Repr arr :: *
+sh2ix :: DIM2 -> (Int, Int)
+sh2ix (Z :. i :. j) = (i, j)
+{-# INLINE sh2ix #-}
 
+ix2sh :: (Int, Int) -> DIM2
+ix2sh !(i, j) = Z :. i :. j
+{-# INLINE ix2sh #-}
 
--- | Repa Array representation, which is computed in parallel.
-data RP r = RP r deriving Typeable
+errorR :: String -> String -> a
+errorR fName errMsg =
+  error $ "Graphics.Image.Interface.Repa.Generic." P.++ fName P.++ ": " P.++ errMsg
 
--- | Repa Array representation, which is computed sequentially. 
-data RS r = RS r deriving Typeable
+checkDimsR :: String -> (Int, Int) -> DIM2
+checkDimsR fName = ix2sh . checkDims ("Graphics.Image.Interface.Repa.Generic." P.++ fName)
+{-# INLINE checkDimsR #-}
 
-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
 
+dimsR :: Source r p => RImage r p -> (Int, Int)
+dimsR (RTImage arr) = sh2ix $ R.extent arr
+dimsR (RDImage arr) = sh2ix $ R.extent arr
+{-# INLINE dimsR #-}
 
------------------------
--- Sequential Arrays --
------------------------
+makeImageR :: (Int, Int) -> ((Int, Int) -> px) -> RImage t px
+makeImageR sz f =
+  RDImage $ R.fromFunction (checkDimsR "makeImageR" sz) (f . sh2ix)
+{-# INLINE makeImageR #-}
 
-instance SuperClass (RS r) cs e => BaseArray (RS r) cs e where
-  type SuperClass (RS r) cs e =
-    (Typeable r, ColorSpace cs e, R.Elt (Pixel cs e), R.Elt e, 
-     R.Target (Repr r) (Pixel cs e), R.Source (Repr r) (Pixel cs e),
-     BaseArray r cs e)
-  
-  data Image (RS r) cs e = SScalar !(Pixel cs e)
-                         | STImage !(R.Array (Repr 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 #-}
+makeImageWindowedR
+  :: (Int, Int)
+  -> (Int, Int)
+  -> (Int, Int)
+  -> ((Int, Int) -> p)
+  -> ((Int, Int) -> p)
+  -> RImage r p
+makeImageWindowedR !sz !wIx !wSz getWindowPx getBorderPx =
+  RDImage $ R.delay $ makeWindowed sh wIx wSz wArr bArr
+  where
+    wArr = R.fromFunction sh (getWindowPx . sh2ix)
+    bArr = R.fromFunction sh (getBorderPx . sh2ix)
+    !sh = checkDimsR "makeImageWindowedR" sz
+{-# INLINE makeImageWindowedR #-}
 
+makeWindowed
+  :: (Source r1 p, Source r2 p)
+  => DIM2 -- ^ Extent of array.
+  -> (Int, Int) -- ^ Window starting index
+  -> (Int, Int) -- ^ Window size.
+  -> Array r1 DIM2 p -- ^ Array for internal elements.
+  -> Array r2 DIM2 p -- ^ Array for border elements.
+  -> Array (P r1 (P r2 (P r2 (P r2 (P r2 X))))) DIM2 p
+makeWindowed sh@(Z :. m :. n) !(it, jt) !(wm, wn) arrWindow arrBorder =
+  let inInternal (Z :. i :. j) = i >= it && i < ib && j >= jt && j < jb
+      {-# INLINE inInternal #-}
+      inBorder = not . inInternal
+      {-# INLINE inBorder #-}
+      !(ib, jb) = (wm + it, wn + jt)
+  in APart sh (Range (Z :. it :. jt) (Z :. wm       :. wn      ) inInternal) arrWindow $
+     APart sh (Range (Z :. 0  :. 0 ) (Z :. it       :. n       ) inBorder  ) arrBorder $
+     APart sh (Range (Z :. it :. 0 ) (Z :. wm       :. jt      ) inBorder  ) arrBorder $
+     APart sh (Range (Z :. it :. jb) (Z :. wm       :. (n - jb)) inBorder  ) arrBorder $
+     APart sh (Range (Z :. ib :. 0 ) (Z :. (m - ib) :. n       ) inBorder  ) arrBorder $
+     AUndefined sh
+{-# INLINE makeWindowed #-}
 
-instance (VG.Vector (Vector r) (Pixel cs e),
-          MArray (Manifest r) cs e, BaseArray (RS r) cs e) => Array (RS r) cs e where
+fromRepaArrayR :: (Source r1 p) => R.Array r1 DIM2 p -> RImage r p
+fromRepaArrayR = RDImage . R.delay
+{-# INLINE fromRepaArrayR #-}
 
-  type Manifest (RS r) = Manifest r
-  
-  type Vector (RS r) = Vector 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))
-    
-  scalar = SScalar
-  {-# INLINE scalar #-}
 
-  index00 (SScalar px)  = px
-  index00 (STImage arr) = R.index arr (Z :. 0 :. 0)
-  index00 (SDImage arr) = R.index arr (Z :. 0 :. 0)
-  {-# INLINE index00 #-}
+scalarR :: p -> RImage t p
+scalarR = RDImage . fromFunction (Z :. 1 :. 1) . const
+{-# INLINE scalarR #-}
 
-  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 #-}
+index00R :: Source r e => RImage r e -> e
+index00R (RTImage arr) = R.index arr (Z :. 0 :. 0)
+index00R (RDImage arr) = R.index arr (Z :. 0 :. 0)
+{-# INLINE index00R #-}
 
-  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 #-}
+mapR :: Source r1 a => (a -> p) -> RImage r1 a -> RImage r p
+mapR f (RTImage arr) = RDImage (R.map f arr)
+mapR f (RDImage arr) = RDImage (R.map f arr)
+{-# INLINE mapR #-}
 
-  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 #-}
+imapR :: Source r2 b =>
+         ((Int, Int) -> b -> p) -> RImage r2 b -> RImage r p
+imapR f (RTImage arr) = RDImage (imapArr (f . sh2ix) arr)
+imapR f (RDImage arr) = RDImage (imapArr (f . sh2ix) arr)
+{-# INLINE imapR #-}
 
-  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 #-}
+imapArr :: R.Source r2 b =>
+           (DIM2 -> b -> c) -> R.Array r2 DIM2 b -> R.Array R.D DIM2 c
+imapArr f !arr = R.traverse arr id (\ getPx !sh -> f sh (getPx sh))
+{-# INLINE imapArr #-}
 
-  backpermute !newDims g !img = SDImage (backpermuteR (getDelayedS img) newDims g)
-  {-# INLINE backpermute #-}
 
-  fromLists = STImage . fromListsRepa
-  {-# INLINE fromLists #-}
+getDelayed :: Source r e => RImage r e -> Array D DIM2 e
+getDelayed (RTImage arr) = delay arr
+getDelayed (RDImage arr) = arr
+{-# INLINE getDelayed #-}
 
-  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 #-}
+zipWithR
+  :: (Source r2 t, Source r1 e) =>
+     (t -> e -> c) -> RImage r2 t -> RImage r1 e -> RImage r c
+zipWithR f !img1 !img2 = zipWithArr f (getDelayed img1) (getDelayed img2)
+{-# INLINE zipWithR #-}
 
-  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 #-}
+zipWithArr
+  :: (Source r1 a, Source r2 b)
+  => (a -> b -> c) -> Array r1 DIM2 a -> Array r2 DIM2 b -> RImage r c
+zipWithArr f arr1 arr2 =
+  RDImage $
+  case (extent arr1, extent arr2) of
+    (Z :. 1 :. 1, _) -> R.map (f (unsafeIndex arr1 (Z :. 0 :. 0))) arr2
+    (_, Z :. 1 :. 1) -> R.map (`f` (unsafeIndex arr2 (Z :. 0 :. 0))) arr1
+    _                -> R.zipWith f arr1 arr2
+{-# INLINE zipWithArr #-}
 
-  eq (SScalar px1) (SScalar px2) = px1 == px2
-  eq !img1 !img2 = R.equalsS (getDelayedS img1) (getDelayedS img2)
-  {-# INLINE eq #-}
+izipWithR
+  :: (Source r2 a, Source r1 b) =>
+     ((Int, Int) -> a -> b -> c)
+     -> RImage r2 a -> RImage r1 b -> RImage r c
+izipWithR f !img1 !img2 = izipWithArr f (getDelayed img1) (getDelayed img2)
+{-# INLINE izipWithR #-}
 
-  compute !img@(SScalar _) = img
-  compute !img@(STImage _) = img
-  compute (SDImage arr)    = STImage (R.computeS arr)
-  {-# INLINE compute #-}
+izipWithArr
+  :: (Source r1 a, Source r2 b)
+  => ((Int, Int) -> a -> b -> c)
+  -> Array r1 DIM2 a
+  -> Array r2 DIM2 b
+  -> RImage r c
+izipWithArr f arr1 arr2 =
+  RDImage $
+  case (extent arr1, extent arr2) of
+    (Z :. 1 :. 1, _) ->
+      imapArr (\ !sh -> f (sh2ix sh) (unsafeIndex arr1 (Z :. 0 :. 0))) arr2
+    (_, Z :. 1 :. 1) ->
+      imapArr
+        (\ !sh !px1 -> f (sh2ix sh) px1 (unsafeIndex arr2 (Z :. 0 :. 0))) arr1
+    (Z :. m1 :. n1, Z :. m2 :. n2) -> traverse2 arr1 arr2 getNewDims getNewPx
+      where getNewDims _ _ = Z :. min m1 m2 :. min n1 n2
+            {-# INLINE getNewDims #-}
+            getNewPx getPx1 getPx2 !sh = f (sh2ix sh) (getPx1 sh) (getPx2 sh)
+            {-# INLINE getNewPx #-}
+{-# INLINE izipWithArr #-}
 
-  (|*|) 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 (scalarR px1) |*| img2
-  (|*|) !img1            (SScalar px2)    = img1 |*| STImage (scalarR px2)
-  {-# INLINE (|*|) #-}
 
-  toManifest _ = error $ "RS.toManifest: Cannot convert generic Repa " ++
-                         "representation to a generic Vector representation."
-  {-# INLINE toManifest #-}
+traverseR
+  :: Source r1 c
+  => RImage r1 c
+  -> ((Int, Int) -> (Int, Int))
+  -> (((Int, Int) -> c) -> (Int, Int) -> p)
+  -> RImage r p
+traverseR img getNewDims getNewPx =
+  RDImage $
+  R.traverse
+    (getDelayed img)
+    (checkDimsR "traverseR" . getNewDims . sh2ix)
+    (\ getPx -> getNewPx (getPx . ix2sh) . sh2ix)
+{-# INLINE traverseR #-}
 
-  toVector _ = error $ "RS.toVector: Cannot convert generic Repa " ++
-                        "representation to a generic Vector."
-  {-# INLINE toVector #-}
+unsafeTraverseR
+  :: Source r1 c
+  => RImage r1 c
+  -> ((Int, Int) -> (Int, Int))
+  -> (((Int, Int) -> c) -> (Int, Int) -> p)
+  -> RImage r p
+unsafeTraverseR img getNewDims getNewPx =
+  RDImage $
+  R.unsafeTraverse
+    (getDelayed img)
+    (checkDimsR "traverseR" . getNewDims . sh2ix)
+    (\ getPx -> getNewPx (getPx . ix2sh) . sh2ix)
+{-# INLINE unsafeTraverseR #-}
 
-  fromVector _ = error $ "RS.fromVector: Cannot convert to generic Repa " ++
-                        "from a generic Vector."
-  {-# INLINE fromVector #-}
 
----------------------
--- Parallel Arrays --
----------------------
+traverse2R
+  :: (Source r1 a, Source r2 b)
+  => RImage r1 a
+  -> RImage r2 b
+  -> ((Int, Int) -> (Int, Int) -> (Int, Int))
+  -> (((Int, Int) -> a) -> ((Int, Int) -> b) -> (Int, Int) -> c)
+  -> RImage r c
+traverse2R img1 img2 getNewDims getNewPx =
+  RDImage $
+  R.traverse2
+    (getDelayed img1)
+    (getDelayed img2)
+    (\ !sh1 !sh2 -> checkDimsR "traverse2R" (getNewDims (sh2ix sh1) (sh2ix sh2)))
+    (\getPx1 getPx2 -> getNewPx (getPx1 . ix2sh) (getPx2 . ix2sh) . sh2ix)
+{-# INLINE traverse2R #-}
 
+unsafeTraverse2R
+  :: (Source r1 a, Source r2 b)
+  => RImage r1 a
+  -> RImage r2 b
+  -> ((Int, Int) -> (Int, Int) -> (Int, Int))
+  -> (((Int, Int) -> a) -> ((Int, Int) -> b) -> (Int, Int) -> c)
+  -> RImage r c
+unsafeTraverse2R img1 img2 getNewDims getNewPx =
+  RDImage $
+  R.unsafeTraverse2
+    (getDelayed img1)
+    (getDelayed img2)
+    (\ !sh1 !sh2 -> checkDimsR "traverse2R" (getNewDims (sh2ix sh1) (sh2ix sh2)))
+    (\getPx1 getPx2 -> getNewPx (getPx1 . ix2sh) (getPx2 . ix2sh) . sh2ix)
+{-# INLINE unsafeTraverse2R #-}
 
 
-instance SuperClass (RP r) cs e => BaseArray (RP r) cs e where
-  type SuperClass (RP r) cs e = (
-    Typeable r, ColorSpace cs e,
-    R.Target (Repr r) (Pixel cs e), R.Source (Repr r) (Pixel cs e),
-    BaseArray r cs e,
-    R.Elt e, R.Elt (Pixel cs e))
-  
-  data Image (RP r) cs e = PScalar !(Pixel cs e)
-                         | PTImage !(R.Array (Repr 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 #-}
+transposeR :: Source r1 p => RImage r1 p -> RImage r p
+transposeR (RDImage arr) = RDImage (R.transpose arr)
+transposeR (RTImage arr) = RDImage (R.transpose arr)
+{-# INLINE transposeR #-}
 
 
-instance (VG.Vector (Vector r) (Pixel cs e),
-          MArray (Manifest r) cs e, BaseArray (RP r) cs e) => Array (RP r) cs e where
+backpermuteR
+  :: R.Source r e
+  => (Int, Int) -> ((Int, Int) -> (Int, Int)) -> RImage r e -> RImage r e
+backpermuteR !newDims g !img =
+  RDImage $ R.backpermute
+    (ix2sh (checkDims "backpermuteR" newDims))
+    (ix2sh . g . sh2ix)
+    (getDelayed img)
+{-# INLINE backpermuteR #-}
 
-  type Manifest (RP r) = Manifest r
 
-  type Vector (RP r) = Vector 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))
-    
-  scalar = PScalar
-  {-# INLINE scalar #-}
 
-  index00 (PScalar px)  = px
-  index00 (PTImage arr) = R.index arr (Z :. 0 :. 0)
-  index00 (PDImage arr) = R.index arr (Z :. 0 :. 0)
-  {-# INLINE index00 #-}
+fromListsR :: Target r p => [[p]] -> RImage r p
+fromListsR ls =
+  if all (== n) (P.map length ls)
+    then RTImage $ R.fromList (Z :. m :. n) . concat $ ls
+    else error "fromListsRepa: Inner lists do not all have an equal length."
+  where
+    !(m, n) = checkDims "fromListsRepa" (length ls, maybe 0 length $ listToMaybe ls)
+{-# INLINE fromListsR #-}
 
-  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 #-}
+multR :: (Num p, Elt p, Unbox p, Source r2 p, Source r1 p, Source r p, Target r p,
+           Target r2 p, Target r1 p) =>
+         Strategy -> RImage r2 p -> RImage r1 p -> RImage r p
+multR strategy (RTImage arr1) (RTImage arr2) =
+  if n1 /= m2
+    then errorR "multR" $
+         "Inner dimensions of multiplied images must be the same, but received: " P.++
+         show (m1, n1) P.++
+         " X " P.++
+         show (m2, n2)
+    else computeR strategy $ RDImage $ 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 #-}
+multR strategy img1 img2 =
+  multR strategy (computeR strategy img1) (computeR strategy img2)
+{-# INLINE multR #-}
 
-  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 #-}
+computeR :: (Target r p, Source r p) => Strategy -> RImage r p -> RImage r p
+computeR Parallel (RDImage arr) = arrManifest `deepSeqArray` RTImage arrManifest
+  where arrManifest = suspendedComputeP arr
+computeR Sequential (RDImage arr) = RTImage $ computeS arr
+computeR _ img = img
+{-# INLINE computeR #-}
 
-  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 #-}
+foldR :: (Source r p, Target r p, Elt p, Unbox p)
+       => Strategy -> (p -> p -> p) -> p -> RImage r p -> p
+foldR Parallel f !px0 !img =
+  let RTImage arr = computeR Parallel img
+  in case foldAllP f px0 arr of
+       Just e  -> e
+       Nothing -> errorR "foldPR" "impossible happened."
+foldR Sequential f !px0 img =
+  let RTImage arr = computeR Sequential img
+  in foldAllS f px0 arr
+{-# INLINE foldR #-}
 
-  fromLists = PTImage . fromListsRepa
-  {-# 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 #-}
+addIxArr
+  :: Source r2 b =>
+     Array r2 DIM2 b -> Array R.D DIM2 (Int, b)
+addIxArr !arr = R.zipWith (,) arrIx arr
+  where
+    !sh = extent arr
+    !arrIx = R.fromFunction (R.extent arr) (toIndex sh)
+{-# INLINE addIxArr #-}
 
-  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 #-}
 
+foldIxR :: (Source r b, Elt b, Unbox b) =>
+           Strategy -> (b -> (Int, Int) -> b -> b) -> b -> RImage r b -> b
+foldIxR strategy f !acc' !img =
+  case strategy of
+    Parallel ->
+      case foldAllP accumWithIx (-1, acc') arr of
+        Just (_, acc) -> acc
+        Nothing       -> error $ "foldIxPR: impossible happened."
+    Sequential -> snd $ R.foldAllS accumWithIx (-1, acc') arr
+  where
+    (Z :. _ :. n) = extent arr
+    !arr = addIxArr (getDelayed img)
+    accumWithIx !(-1, acc) !(k, px) = (-1, f acc (toIx n k) px)
+    accumWithIx !(k, px) (-1, acc) = (-1, f acc (toIx n k) px)
+    accumWithIx (acc1Ix, _) (acc2Ix, _) =
+      errorR "accumWithx" $
+      "Impossible happened. Received: " P.++ show acc1Ix P.++ " " P.++
+      show acc2Ix
+    {-# INLINE accumWithIx #-}
+{-# INLINE foldIxR #-}
 
-  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 #-}
+eqR :: (Eq a, Source r1 a, Source r a) =>
+        Strategy -> RImage r1 a -> RImage r a -> Bool
+eqR strategy !img1 !img2 =
+  case strategy of
+    Parallel ->
+      let eqArr = R.zipWith (==) (getDelayed img1) (getDelayed img2)
+      in dimsR img1 == dimsR img2 && mCompute "eqR" (foldAllP (&&) True eqArr)
+    Sequential -> R.equalsS (getDelayed img1) (getDelayed img2)
+{-# INLINE eqR #-}
 
-  (|*|) 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 (scalarR px1) |*| img2
-  (|*|) !img1            (PScalar px2)    = img1 |*| PTImage (scalarR px2)
-  {-# INLINE (|*|) #-}
+mCompute :: String -> Maybe t -> t
+mCompute _ (Just res)  = res
+mCompute fName Nothing = errorR fName "impossible happened"
+{-# INLINE mCompute #-}
 
-  toManifest _ = error $ "RP.toManifest: Cannot convert generic Repa " ++
-                         "representation to a generic Vector."
-  {-# INLINE toManifest #-}
 
-  toVector _ = error $ "RP.toVector: Cannot convert generic Repa " ++
-                        "representation to a generic Vector."
-  {-# INLINE toVector #-}
 
-  fromVector _ = error $ "RP.fromVector: Cannot convert to generic Repa " ++
-                        "from a generic Vector."
-  {-# INLINE fromVector #-}
+fromVectorUnboxedR :: Unbox e => (Int, Int) -> VU.Vector e -> RImage U e
+fromVectorUnboxedR !sz = RTImage . fromUnboxed (ix2sh sz)
+{-# INLINE fromVectorUnboxedR #-}
 
- 
 
-----------------------
--- Helper functions --
-----------------------
 
-sh2ix :: DIM2 -> (Int, Int)
-sh2ix (Z :. i :. j) = (i, j)
-{-# INLINE sh2ix #-}
+toVectorR :: (Target r2 e, Source r2 e) =>
+             (R.Array r2 DIM2 e -> t) -> Strategy -> RImage r2 e -> t
+toVectorR toVector Parallel (RDImage arr) =
+ toVector $ mCompute "toVectorR" (computeP arr)
+toVectorR toVector Sequential (RDImage arr) = toVector $ computeS arr
+toVectorR toVector _ (RTImage arr) = toVector arr
+{-# INLINE toVectorR #-}
 
-ix2sh :: (Int, Int) -> DIM2
-ix2sh !(i, j) = Z :. i :. j 
-{-# INLINE ix2sh #-}
 
+toVectorUnboxedR :: Unbox e => Strategy -> RImage U e -> VU.Vector e
+toVectorUnboxedR = toVectorR toUnboxed
+{-# INLINE toVectorUnboxedR #-}
 
-toRS :: 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
+toVectorStorableR :: VS.Storable e => Strategy -> RImage F e -> VS.Vector e
+toVectorStorableR = toVectorR toStorableR
+{-# INLINE toVectorStorableR #-}
 
-toRP :: 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
+toStorableR :: VS.Storable a => Array F DIM2 a -> VS.Vector a
+toStorableR arr = VS.unsafeFromForeignPtr0 (toForeignPtr arr) (m * n)
   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 #-}
+    (Z :. m :. n) = R.extent arr
+{-# INLINE toStorableR #-}
 
 
-fromListsRepa :: (R.Target r e) => [[e]] -> R.Array r DIM2 e
-fromListsRepa ls =
-  if all (== n) (P.map length ls)
-    then R.fromList (Z :. m :. n) . concat $ ls
-    else error "fromListsRepa: Inner lists do not all have an equal length."
+fromVectorStorableR
+  :: VS.Storable px
+  => (Int, Int) -> VS.Vector px -> RImage F px
+fromVectorStorableR !(m, n) !v
+  | sz == sz' = RTImage $ fromForeignPtr (ix2sh (m, n)) fp
+  | otherwise =
+    errorR "fromVectorStorableR" $
+    "(impossible) Vector size mismatch: " P.++ show sz P.++ " vs " P.++ show sz'
   where
-    !(m, n) = checkDims "fromListsRepa" (length ls, length $ head ls)
-{-# INLINE fromListsRepa #-}
+    !(fp, sz) = VS.unsafeToForeignPtr0 v
+    !sz' = m * n
+{-# INLINE fromVectorStorableR #-}
 
 
 
-multR
-  :: (ColorSpace 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 #-}
 
+instance (Num e, R.Elt e) => Elt (C.Complex e) where
+  touch (r :+ i) = R.touch r >> R.touch i
+  {-# INLINE touch #-}
 
-scalarR :: (IVU.Unbox a, R.Target r a) => a -> R.Array r DIM2 a
-scalarR !px = R.computeS $ R.fromFunction (Z :. 1 :. 1) $ const px
+  zero     = 0 :+ 0
+  {-# INLINE zero #-}
 
+  one      = 1 :+ 0
+  {-# INLINE one #-}
 
-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
+instance 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)) 
+instance (ColorSpace cs e, Elt e, Num (Pixel cs e)) => Elt (Pixel cs e) where
+  touch = foldlPx (\ a !e -> a >> touch e) (return ())
   {-# 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, IVU.Unbox b, R.Source r2 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
deleted file mode 100644
--- a/src/Graphics/Image/Interface/Repa/Helpers.hs
+++ /dev/null
@@ -1,39 +0,0 @@
-{-# 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/Storable.hs b/src/Graphics/Image/Interface/Repa/Storable.hs
--- a/src/Graphics/Image/Interface/Repa/Storable.hs
+++ b/src/Graphics/Image/Interface/Repa/Storable.hs
@@ -1,13 +1,12 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE BangPatterns          #-}
+{-# LANGUAGE ConstraintKinds       #-}
+{-# LANGUAGE DeriveDataTypeable    #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE UndecidableInstances  #-}
 -- |
 -- Module      : Graphics.Image.Interface.Repa.Storable
 -- Copyright   : (c) Alexey Kuleshevich 2017
@@ -20,23 +19,20 @@
   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 Data.Typeable (Typeable)
-
-import Graphics.Image.Interface as I
-import Graphics.Image.Interface.Repa.Generic
+import qualified Data.Array.Repa.Eval                     as R
+import qualified Data.Array.Repa.Repr.ForeignPtr          as R
+import           Data.Typeable                            (Typeable)
+import           Data.Vector.Unboxed                      (Unbox)
+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           Prelude                                  as P
 
 
 
 
--- | Repa Array representation backed by Storable Vector, which is computed sequentially. 
+-- | Repa Array representation backed by Storable Vector, which is computed sequentially.
 data RSS = RSS deriving Typeable
 
 -- | Repa Array representation backed by Storable Vector, which is computed in parallel.
@@ -47,20 +43,17 @@
 
 instance Show RPS where
   show _ = "RepaParallelStorable"
-  
 
-type instance Repr IVS.VS = R.F
 
-
 instance SuperClass RSS cs e => BaseArray RSS cs e where
   type SuperClass RSS cs e =
-    (ColorSpace cs e,
+    (ColorSpace cs e, Unbox (Pixel cs e),
      Storable e, Storable (Pixel cs e),
      R.Elt e, R.Elt (Pixel cs e))
-  
-  newtype Image RSS cs e = SSImage (Image (RS IVS.VS) cs e)
-                       
-  dims (SSImage img) = dims img
+
+  newtype Image RSS cs e = SSImage (RImage R.F (Pixel cs e))
+
+  dims (SSImage img) = dimsR img
   {-# INLINE dims #-}
 
 
@@ -69,82 +62,80 @@
   type Manifest RSS = IVS.VS
 
   type Vector RSS = Vector IVS.VS
-  
-  makeImage !sz f = SSImage (makeImage sz f)
+
+  makeImage !sz f = SSImage (makeImageR sz f)
   {-# INLINE makeImage #-}
- 
-  makeImageWindowed !sz !w f = SSImage . makeImageWindowed sz w f
+
+  makeImageWindowed !sz !wIx !wSz f = SSImage . makeImageWindowedR sz wIx wSz f
   {-# INLINE makeImageWindowed #-}
- 
-  scalar = SSImage . I.scalar
+
+  scalar = SSImage . scalarR
   {-# INLINE scalar #-}
 
-  index00 (SSImage img) = index00 img
+  index00 (SSImage img) = index00R img
   {-# INLINE index00 #-}
 
-  map f (SSImage img) = SSImage (I.map f img)
+  map f (SSImage img) = SSImage (mapR f img)
   {-# INLINE map #-}
 
-  imap f (SSImage img) = SSImage (I.imap f img)
+  imap f (SSImage img) = SSImage (imapR f img)
   {-# INLINE imap #-}
 
-  zipWith f (SSImage img1) (SSImage img2) = SSImage (I.zipWith f img1 img2)
+  zipWith f (SSImage img1) (SSImage img2) = SSImage (zipWithR f img1 img2)
   {-# INLINE zipWith #-}
 
-  izipWith f (SSImage img1) (SSImage img2) = SSImage (I.izipWith f img1 img2)
+  izipWith f (SSImage img1) (SSImage img2) = SSImage (izipWithR f img1 img2)
   {-# INLINE izipWith #-}
 
-  traverse (SSImage img) f g = SSImage (I.traverse img f g)
+  traverse (SSImage img) f g = SSImage (traverseR img f g)
   {-# INLINE traverse #-}
 
-  traverse2 (SSImage img1) (SSImage img2) f g = SSImage (I.traverse2 img1 img2 f g)
+  traverse2 (SSImage img1) (SSImage img2) f g = SSImage (traverse2R img1 img2 f g)
   {-# INLINE traverse2 #-}
 
-  transpose (SSImage img) = SSImage (I.transpose img)
+  transpose (SSImage img) = SSImage (transposeR img)
   {-# INLINE transpose #-}
 
-  backpermute !sz g (SSImage img) = SSImage (I.backpermute sz g img)
+  backpermute !sz g (SSImage img) = SSImage (backpermuteR sz g img)
   {-# INLINE backpermute #-}
 
-  fromLists = SSImage . fromLists
+  fromLists = SSImage . fromListsR
   {-# INLINE fromLists #-}
 
-  fold f !px0 (SSImage img) = fold f px0 img
+  fold f !px0 (SSImage img) = foldR Sequential f px0 img
   {-# INLINE fold #-}
 
-  foldIx f !px0 (SSImage img) = foldIx f px0 img
+  foldIx f !px0 (SSImage img) = foldIxR Sequential f px0 img
   {-# INLINE foldIx #-}
 
-  eq (SSImage img1) (SSImage img2) = img1 == img2
+  eq (SSImage img1) (SSImage img2) = eqR Sequential img1 img2
   {-# INLINE eq #-}
 
-  compute (SSImage img) = SSImage (compute img)
+  compute (SSImage img) = SSImage (computeR Sequential img)
   {-# INLINE compute #-}
 
-  (|*|) (SSImage img1) (SSImage img2) = SSImage (img1 |*| img2)
+  (|*|) (SSImage img1) (SSImage img2) = SSImage (multR Sequential img1 img2)
   {-# INLINE (|*|) #-}
 
-  toManifest (SSImage (SScalar px)) = I.scalar px
-  toManifest (SSImage (STImage arr)) = fromRepaArrayStorable arr
-  toManifest !img = toManifest (compute img)
+  toManifest (SSImage img) = fromVector (dimsR img) $ toVectorStorableR Sequential img
   {-# INLINE toManifest #-}
 
-  toVector = I.toVector . toManifest
+  toVector (SSImage img) = toVectorStorableR Sequential img
   {-# INLINE toVector #-}
 
-  fromVector !sz = SSImage . STImage . fromVectorStorable sz
+  fromVector !sz = SSImage . fromVectorStorableR sz
   {-# INLINE fromVector #-}
 
 
 instance SuperClass RPS cs e => BaseArray RPS cs e where
   type SuperClass RPS cs e =
     (ColorSpace cs e,
-     Storable e, Storable (Pixel cs e),
+     Storable e, Storable (Pixel cs e), Unbox (Pixel cs e),
      R.Elt e, R.Elt (Pixel cs e))
-  
-  newtype Image RPS cs e = PSImage (Image (RP IVS.VS) cs e)
-                       
-  dims (PSImage img) = dims img
+
+  newtype Image RPS cs e = PSImage (RImage R.F (Pixel cs e))
+
+  dims (PSImage img) = dimsR img
   {-# INLINE dims #-}
 
 
@@ -153,92 +144,66 @@
   type Manifest RPS = IVS.VS
 
   type Vector RPS = Vector IVS.VS
-  
-  makeImage !sz f = PSImage (makeImage sz f)
+
+  makeImage !sz f = PSImage (makeImageR sz f)
   {-# INLINE makeImage #-}
- 
-  makeImageWindowed !sz !w f = PSImage . makeImageWindowed sz w f
+
+  makeImageWindowed !sz !wIx !wSz f = PSImage . makeImageWindowedR sz wIx wSz f
   {-# INLINE makeImageWindowed #-}
- 
-  scalar = PSImage . scalar
+
+  scalar = PSImage . scalarR
   {-# INLINE scalar #-}
 
-  index00 (PSImage img) = index00 img
+  index00 (PSImage img) = index00R img
   {-# INLINE index00 #-}
 
-  map f (PSImage img) = PSImage (I.map f img)
+  map f (PSImage img) = PSImage (mapR f img)
   {-# INLINE map #-}
 
-  imap f (PSImage img) = PSImage (I.imap f img)
+  imap f (PSImage img) = PSImage (imapR f img)
   {-# INLINE imap #-}
 
-  zipWith f (PSImage img1) (PSImage img2) = PSImage (I.zipWith f img1 img2)
+  zipWith f (PSImage img1) (PSImage img2) = PSImage (zipWithR f img1 img2)
   {-# INLINE zipWith #-}
 
-  izipWith f (PSImage img1) (PSImage img2) = PSImage (I.izipWith f img1 img2)
+  izipWith f (PSImage img1) (PSImage img2) = PSImage (izipWithR f img1 img2)
   {-# INLINE izipWith #-}
 
-  traverse (PSImage img) f g = PSImage (I.traverse img f g)
+  traverse (PSImage img) f g = PSImage (traverseR img f g)
   {-# INLINE traverse #-}
 
-  traverse2 (PSImage img1) (PSImage img2) f g = PSImage (I.traverse2 img1 img2 f g)
+  traverse2 (PSImage img1) (PSImage img2) f g = PSImage (traverse2R img1 img2 f g)
   {-# INLINE traverse2 #-}
 
-  transpose (PSImage img) = PSImage (I.transpose img)
+  transpose (PSImage img) = PSImage (transposeR img)
   {-# INLINE transpose #-}
 
-  backpermute !sz g (PSImage img) = PSImage (backpermute sz g img)
+  backpermute !sz g (PSImage img) = PSImage (backpermuteR sz g img)
   {-# INLINE backpermute #-}
 
-  fromLists = PSImage . fromLists
+  fromLists = PSImage . fromListsR
   {-# INLINE fromLists #-}
 
-  fold f !px0 (PSImage img) = I.fold f px0 img
+  fold f !px0 (PSImage img) = foldR Parallel f px0 img
   {-# INLINE fold #-}
 
-  foldIx f !px0 (PSImage img) = I.foldIx f px0 img
+  foldIx f !px0 (PSImage img) = foldIxR Parallel f px0 img
   {-# INLINE foldIx #-}
 
-  eq (PSImage img1) (PSImage img2) = img1 == img2
+  eq (PSImage img1) (PSImage img2) = eqR Parallel img1 img2
   {-# INLINE eq #-}
 
-  compute (PSImage img) = PSImage (compute img)
+  compute (PSImage img) = PSImage (computeR Parallel img)
   {-# INLINE compute #-}
 
-  (|*|) (PSImage img1) (PSImage img2) = PSImage (img1 |*| img2)
+  (|*|) (PSImage img1) (PSImage img2) = PSImage (multR Parallel img1 img2)
   {-# INLINE (|*|) #-}
 
-  toManifest (PSImage (PScalar px))  = scalar px
-  toManifest (PSImage (PTImage arr)) = fromRepaArrayStorable arr
-  toManifest !img = toManifest (compute img)
+  toManifest (PSImage img) = fromVector (dimsR img) $ toVectorStorableR Parallel img
   {-# INLINE toManifest #-}
 
-  toVector = I.toVector . toManifest
+  toVector (PSImage img) = toVectorStorableR Parallel img
   {-# INLINE toVector #-}
 
-  fromVector !sz = PSImage . PTImage . fromVectorStorable sz
+  fromVector !sz = PSImage . fromVectorStorableR sz
   {-# INLINE fromVector #-}
-
-
-fromRepaArrayStorable
-  :: forall cs e.
-     Array IVS.VS cs e
-  => R.Array R.F DIM2 (Pixel cs e) -> Image IVS.VS cs e
-fromRepaArrayStorable !arr =
-  fromVector (sh2ix (R.extent arr)) $
-  VS.unsafeFromForeignPtr0 (R.toForeignPtr arr) (m * n)
-  where
-    (Z :. m :. n) = R.extent arr
-
-
-fromVectorStorable
-  :: forall cs e.
-     Storable (Pixel cs e)
-  => (Int, Int) -> VS.Vector (Pixel cs e) -> R.Array R.F DIM2 (Pixel cs e)
-fromVectorStorable !(m, n) !v
-  | sz == sz' = R.fromForeignPtr (ix2sh (m, n)) fp
-  | otherwise = error $ "fromVectorStorable: (impossible) Vector size mismatch: " ++
-                show sz ++ " vs " ++ show sz'
-  where
-    !(fp, sz) = VS.unsafeToForeignPtr0 v
-    !sz' = m * n
diff --git a/src/Graphics/Image/Interface/Repa/Unboxed.hs b/src/Graphics/Image/Interface/Repa/Unboxed.hs
--- a/src/Graphics/Image/Interface/Repa/Unboxed.hs
+++ b/src/Graphics/Image/Interface/Repa/Unboxed.hs
@@ -1,13 +1,12 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE BangPatterns          #-}
+{-# LANGUAGE ConstraintKinds       #-}
+{-# LANGUAGE DeriveDataTypeable    #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE UndecidableInstances  #-}
 -- |
 -- Module      : Graphics.Image.Interface.Repa.Unboxed
 -- Copyright   : (c) Alexey Kuleshevich 2017
@@ -20,17 +19,17 @@
   RSU(..), RPU(..), Image(..)
   ) where
 
-import Prelude as P
-import qualified Data.Array.Repa as R 
-import qualified Data.Array.Repa.Eval as R
-import Data.Typeable (Typeable)
+import qualified Data.Array.Repa                         as R
+import qualified Data.Array.Repa.Eval                    as R
+import           Data.Typeable                           (Typeable)
+import           Prelude                                 as P
 
-import Graphics.Image.Interface as I
-import Graphics.Image.Interface.Repa.Generic
+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. 
+-- | Repa Array representation backed by Unboxed Vector, which is computed sequentially.
 data RSU = RSU deriving Typeable
 
 -- | Repa Array representation backed by Unboxed Vector, which is computed in parallel.
@@ -41,19 +40,16 @@
 
 instance Show RPU where
   show _ = "RepaParallelUnboxed"
-  
 
-type instance Repr IVU.VU = R.U
 
-
 instance SuperClass RSU cs e => BaseArray RSU cs e where
   type SuperClass RSU cs e =
     (ColorSpace cs e,
      R.Elt e, R.Elt (Pixel cs e))
-  
-  newtype Image RSU cs e = SUImage (Image (RS IVU.VU) cs e)
-                       
-  dims (SUImage img) = dims img
+
+  newtype Image RSU cs e = SUImage (RImage R.U (Pixel cs e))
+
+  dims (SUImage img) = dimsR img
   {-# INLINE dims #-}
 
 
@@ -62,152 +58,148 @@
   type Manifest RSU = IVU.VU
 
   type Vector RSU = Vector IVU.VU
-  
-  makeImage !sz f = SUImage (makeImage sz f)
+
+  makeImage !sz f = SUImage (makeImageR sz f)
   {-# INLINE makeImage #-}
- 
-  makeImageWindowed !sz !w f = SUImage . makeImageWindowed sz w f
+
+  makeImageWindowed !sz !wIx !wSz f = SUImage . makeImageWindowedR sz wIx wSz f
   {-# INLINE makeImageWindowed #-}
- 
-  scalar = SUImage . scalar
+
+  scalar = SUImage . scalarR
   {-# INLINE scalar #-}
 
-  index00 (SUImage img) = index00 img
+  index00 (SUImage img) = index00R img
   {-# INLINE index00 #-}
 
-  map f (SUImage img) = SUImage (I.map f img)
+  map f (SUImage img) = SUImage (mapR f img)
   {-# INLINE map #-}
 
-  imap f (SUImage img) = SUImage (I.imap f img)
+  imap f (SUImage img) = SUImage (imapR f img)
   {-# INLINE imap #-}
 
-  zipWith f (SUImage img1) (SUImage img2) = SUImage (I.zipWith f img1 img2)
+  zipWith f (SUImage img1) (SUImage img2) = SUImage (zipWithR f img1 img2)
   {-# INLINE zipWith #-}
 
-  izipWith f (SUImage img1) (SUImage img2) = SUImage (I.izipWith f img1 img2)
+  izipWith f (SUImage img1) (SUImage img2) = SUImage (izipWithR f img1 img2)
   {-# INLINE izipWith #-}
 
-  traverse (SUImage img) f g = SUImage (I.traverse img f g)
+  traverse (SUImage img) f g = SUImage (traverseR img f g)
   {-# INLINE traverse #-}
 
-  traverse2 (SUImage img1) (SUImage img2) f g = SUImage (I.traverse2 img1 img2 f g)
+  traverse2 (SUImage img1) (SUImage img2) f g = SUImage (traverse2R img1 img2 f g)
   {-# INLINE traverse2 #-}
 
-  transpose (SUImage img) = SUImage (I.transpose img)
+  transpose (SUImage img) = SUImage (transposeR img)
   {-# INLINE transpose #-}
 
-  backpermute !sz g (SUImage img) = SUImage (backpermute sz g img)
+  backpermute !sz g (SUImage img) = SUImage (backpermuteR sz g img)
   {-# INLINE backpermute #-}
 
-  fromLists = SUImage . fromLists
+  fromLists = SUImage . fromListsR
   {-# INLINE fromLists #-}
 
-  fold f !px0 (SUImage img) = fold f px0 img
+  fold f !px0 (SUImage img) = foldR Sequential f px0 img
   {-# INLINE fold #-}
 
-  foldIx f !px0 (SUImage img) = foldIx f px0 img
+  foldIx f !px0 (SUImage img) = foldIxR Sequential f px0 img
   {-# INLINE foldIx #-}
 
-  eq (SUImage img1) (SUImage img2) = img1 == img2
+  eq (SUImage img1) (SUImage img2) = eqR Sequential img1 img2
   {-# INLINE eq #-}
 
-  compute (SUImage img) = SUImage (compute img)
+  compute (SUImage img) = SUImage (computeR Sequential img)
   {-# INLINE compute #-}
 
-  (|*|) (SUImage img1) (SUImage img2) = SUImage (img1 |*| img2)
+  (|*|) (SUImage img1) (SUImage img2) = SUImage (multR Sequential img1 img2)
   {-# INLINE (|*|) #-}
 
-  toManifest (SUImage (SScalar px)) = scalar px
-  toManifest (SUImage (STImage arr)) =
-    fromVector (sh2ix (R.extent arr)) (R.toUnboxed arr)
-  toManifest !img = toManifest (compute img)
+  toManifest (SUImage img) = fromVector (dimsR img) (toVectorUnboxedR Sequential img)
   {-# INLINE toManifest #-}
 
-  toVector = I.toVector . toManifest
+  toVector (SUImage img) = toVectorUnboxedR Sequential img
   {-# INLINE toVector #-}
 
-  fromVector sz = SUImage . STImage . R.fromUnboxed (ix2sh sz)
+  fromVector !sz = SUImage . fromVectorUnboxedR sz
   {-# INLINE fromVector #-}
 
 
+
 instance SuperClass RPU cs e => BaseArray RPU cs e where
   type SuperClass RPU cs e =
     (ColorSpace cs e, R.Elt e, R.Elt (Pixel cs e))
-  
-  newtype Image RPU cs e = PUImage (Image (RP IVU.VU) cs e)
-                       
-  dims (PUImage img) = dims img
+
+  newtype Image RPU cs e = PUImage (RImage R.U (Pixel cs e))
+
+  dims (PUImage img) = dimsR img
   {-# INLINE dims #-}
 
 
 instance BaseArray RPU cs e => Array RPU cs e where
 
   type Manifest RPU = IVU.VU
-  
+
   type Vector RPU = Vector IVU.VU
-  
-  makeImage !sz f = PUImage (makeImage sz f)
+
+  makeImage !sz f = PUImage (makeImageR sz f)
   {-# INLINE makeImage #-}
- 
-  makeImageWindowed !sz !w f = PUImage . makeImageWindowed sz w f
+
+  makeImageWindowed !sz !wIx !wSz f = PUImage . makeImageWindowedR sz wIx wSz f
   {-# INLINE makeImageWindowed #-}
- 
-  scalar = PUImage . scalar
+
+  scalar = PUImage . scalarR
   {-# INLINE scalar #-}
 
-  index00 (PUImage img) = index00 img
+  index00 (PUImage img) = index00R img
   {-# INLINE index00 #-}
 
-  map f (PUImage img) = PUImage (I.map f img)
+  map f (PUImage img) = PUImage (mapR f img)
   {-# INLINE map #-}
 
-  imap f (PUImage img) = PUImage (I.imap f img)
+  imap f (PUImage img) = PUImage (imapR f img)
   {-# INLINE imap #-}
 
-  zipWith f (PUImage img1) (PUImage img2) = PUImage (I.zipWith f img1 img2)
+  zipWith f (PUImage img1) (PUImage img2) = PUImage (zipWithR f img1 img2)
   {-# INLINE zipWith #-}
 
-  izipWith f (PUImage img1) (PUImage img2) = PUImage (I.izipWith f img1 img2)
+  izipWith f (PUImage img1) (PUImage img2) = PUImage (izipWithR f img1 img2)
   {-# INLINE izipWith #-}
 
-  traverse (PUImage img) f g = PUImage (I.traverse img f g)
+  traverse (PUImage img) f g = PUImage (traverseR img f g)
   {-# INLINE traverse #-}
 
-  traverse2 (PUImage img1) (PUImage img2) f g = PUImage (I.traverse2 img1 img2 f g)
+  traverse2 (PUImage img1) (PUImage img2) f g = PUImage (traverse2R img1 img2 f g)
   {-# INLINE traverse2 #-}
 
-  transpose (PUImage img) = PUImage (I.transpose img)
+  transpose (PUImage img) = PUImage (transposeR img)
   {-# INLINE transpose #-}
 
-  backpermute !sz g (PUImage img) = PUImage (backpermute sz g img)
+  backpermute !sz g (PUImage img) = PUImage (backpermuteR sz g img)
   {-# INLINE backpermute #-}
 
-  fromLists = PUImage . fromLists
+  fromLists = PUImage . fromListsR
   {-# INLINE fromLists #-}
 
-  fold f !px0 (PUImage img) = I.fold f px0 img
+  fold f !px0 (PUImage img) = foldR Parallel f px0 img
   {-# INLINE fold #-}
 
-  foldIx f !px0 (PUImage img) = I.foldIx f px0 img
+  foldIx f !px0 (PUImage img) = foldIxR Parallel f px0 img
   {-# INLINE foldIx #-}
 
-  eq (PUImage img1) (PUImage img2) = img1 == img2
+  eq (PUImage img1) (PUImage img2) = eqR Parallel img1 img2
   {-# INLINE eq #-}
 
-  compute (PUImage img) = PUImage (compute img)
+  compute (PUImage img) = PUImage (computeR Parallel img)
   {-# INLINE compute #-}
 
-  (|*|) (PUImage img1) (PUImage img2) = PUImage (img1 |*| img2)
+  (|*|) (PUImage img1) (PUImage img2) = PUImage (multR Parallel img1 img2)
   {-# INLINE (|*|) #-}
 
-  toManifest (PUImage (PScalar px)) = scalar px
-  toManifest (PUImage (PTImage arr)) =
-    fromVector (sh2ix (R.extent arr)) (R.toUnboxed arr)
-  toManifest !img = toManifest (compute img)
+
+  toManifest (PUImage img) = fromVector (dimsR img) (toVectorUnboxedR Parallel img)
   {-# INLINE toManifest #-}
 
-  toVector = I.toVector . toManifest
+  toVector (PUImage img) = toVectorUnboxedR Parallel img
   {-# INLINE toVector #-}
 
-  fromVector sz = PUImage . PTImage . R.fromUnboxed (ix2sh sz)
+  fromVector !sz = PUImage . fromVectorUnboxedR sz
   {-# INLINE fromVector #-}
diff --git a/src/Graphics/Image/Interface/Vector/Generic.hs b/src/Graphics/Image/Interface/Vector/Generic.hs
--- a/src/Graphics/Image/Interface/Vector/Generic.hs
+++ b/src/Graphics/Image/Interface/Vector/Generic.hs
@@ -1,15 +1,11 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE BangPatterns          #-}
+{-# LANGUAGE CPP                   #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE Rank2Types #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE Rank2Types            #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeFamilies          #-}
 -- |
 -- Module      : Graphics.Image.Interface.Vector.Generic
 -- Copyright   : (c) Alexey Kuleshevich 2017
@@ -18,265 +14,482 @@
 -- Stability   : experimental
 -- Portability : non-portable
 --
-module Graphics.Image.Interface.Vector.Generic (
-  G(..), Image(..), fromVector
-  ) where
+module Graphics.Image.Interface.Vector.Generic
+  ( VGImage
+  , MVGImage
+  , makeImageVG
+  , dimsVG
+  , scalarVG
+  , index00VG
+  , makeImageWindowedVG
+  , mapVG
+  , imapVG
+  , zipWithVG
+  , izipWithVG
+  , unsafeTraverseVG
+  , traverseVG
+  , unsafeTraverse2VG
+  , traverse2VG
+  , transposeVG
+  , unsafeBackpermuteVG
+  , backpermuteVG
+  , fromListsVG
+  , foldlVG
+  , foldrVG
+  , ifoldlVG
+  , toVectorVG
+  , fromVectorVG
+  , multVG
+  , unsafeIndexVG
+  , makeImageMVG
+  , mapMVG
+  , mapM_VG
+  , foldMVG
+  , foldM_VG
+  , mdimsVG
+  , thawVG
+  , freezeVG
+  , newVG
+  , readVG
+  , writeVG
+  , swapVG
+  )
+where
 
-import Prelude hiding (map, zipWith)
-import qualified Prelude as P (map)
-import Control.DeepSeq (NFData, deepseq)
-import Control.Monad
-import Control.Monad.ST
+import           Control.DeepSeq             (NFData (rnf))
+import           Control.Monad               (when)
+import           Control.Monad.Primitive     (PrimMonad, PrimState)
+import           Control.Monad.ST            (ST)
+import           Prelude                     hiding (map, zipWith)
 #if !MIN_VERSION_base(4,8,0)
-import Data.Functor
+import           Data.Functor
 #endif
-import Data.Primitive.MutVar
-import Data.Typeable (Typeable)
-import qualified Data.Vector.Unboxed as VU
-import qualified Data.Vector.Generic as VG
+import           Data.Maybe                  (listToMaybe)
+import qualified Data.Vector.Generic         as VG
 import qualified Data.Vector.Generic.Mutable as MVG
-import Graphics.Image.Interface as I
+import           Graphics.Image.Interface    (checkDims, fromIx,
+                                              handleBorderIndex, toIx)
+import           Graphics.Image.Utils        (loopM_, swapIx)
 
--- | Generic 'Vector' representation.
-data G r = G r deriving Typeable
 
+data VGImage v p =
+  VGImage {-# UNPACK #-}!Int
+          {-# UNPACK #-}!Int
+          !(v p)
 
-instance Show r => Show (G r) where
-  show (G r) = "Vector " ++ show r
+instance NFData (v p) => NFData (VGImage v p) where
+  rnf (VGImage _ _ v) = rnf v
+  {-# INLINE rnf #-}
 
-instance SuperClass (G r) cs e => BaseArray (G r) cs e where
-  type SuperClass (G r) cs e =
-    (Typeable r, ColorSpace cs e,
-     VG.Vector (Vector r) Int, VG.Vector (Vector r) Bool,
-     VG.Vector (Vector r) (Pixel cs e), NFData ((Vector r) (Pixel cs e)))
+instance Eq (v p) => Eq (VGImage v p) where
+  (VGImage _ _ v1) == (VGImage _ _ v2) = v1 == v2
+  {-# INLINE (==) #-}
 
-  data Image (G r) cs e = VScalar !(Pixel cs e)
-                        | VImage {-# UNPACK #-} !Int
-                                 {-# UNPACK #-} !Int
-                                 !((Vector (G r)) (Pixel cs e))
+makeImageVG :: VG.Vector v p =>
+               (Int, Int) -> ((Int, Int) -> p) -> VGImage v p
+makeImageVG !sz f =
+  let !(m, n) = checkDimsVG "makeImageVGM" sz in
+    VGImage m n $ VG.generate (m * n) (f . toIx n)
+{-# INLINE makeImageVG #-}
 
-  dims (VImage m n _) = (m, n)
-  dims (VScalar _)    = (1, 1)
-  {-# INLINE dims #-}
+dimsVG :: VGImage v p -> (Int, Int)
+dimsVG (VGImage m n _) = (m, n)
+{-# INLINE dimsVG #-}
 
 
-instance (VG.Vector (Vector r) (Pixel cs e),
-          MArray (G r) cs e, BaseArray (G r) cs e) => Array (G r) cs e where
+scalarVG :: VG.Vector v p => p -> VGImage v p
+scalarVG = makeImageVG (1,1) . const
+{-# INLINE scalarVG #-}
 
-  type Manifest (G r) = G r
+index00VG :: VG.Vector v p => VGImage v p -> p
+index00VG (VGImage _ _ v) = v VG.! 0
+{-# INLINE index00VG #-}
 
-  type Vector (G r) = Vector r
+-- makeImageVG
+--   :: forall v p.
+--      VG.Vector v p
+--   => (Int, Int)
+--   -> ((Int, Int) -> p)
+--   -> VGImage v p
+-- makeImageVG !sz getPx =
+--   VGImage m n $ VG.create generateImage
+--   where
+--     !(m, n) = checkDimsVG "makeImageVG" sz
+--     generateImage :: ST s ((VG.Mutable v) s p)
+--     generateImage = do
+--       mv <- MVG.unsafeNew (m * n)
+--       loopM_ 0 (< m) (+ 1) $ \ !i -> do
+--         loopM_ 0 (< n) (+ 1) $ \ !j -> do
+--           MVG.unsafeWrite mv (fromIx n (i, j)) (getPx (i, j))
+--       return mv
+--     {-# INLINE generateImage #-}
+-- {-# INLINE makeImageVG #-}
 
-  makeImage !(checkDims "(G r).makeImage" -> (m, n)) f =
-    VImage m n $ VG.generate (m * n) (f . toIx n)
-  {-# INLINE makeImage #-}
 
-  -- TODO: add checkWithin
-  makeImageWindowed !sz !((it, jt), (ib, jb)) getWindowPx getBorderPx =
-    VImage m n $ VG.create generate where
-      !(m, n) = checkDims "(G r).makeImageWindowed" sz
-      nestedLoop :: (VG.Mutable (Vector 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-fi)) $ \i ->
-          VU.forM_ (VU.enumFromN fj (tj-fj)) $ \j ->
-            MVG.unsafeWrite mv (fromIx n (i, j)) (getPx (i, j))
-      {-# INLINE nestedLoop #-}
-      generate :: ST s ((VG.Mutable (Vector (G 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 #-}
-  
-  scalar = VScalar
-  {-# INLINE scalar #-}
+makeImageWindowedVG
+  :: forall v p.
+     VG.Vector v p
+  => (Int, Int)
+  -> (Int, Int)
+  -> (Int, Int)
+  -> ((Int, Int) -> p)
+  -> ((Int, Int) -> p)
+  -> VGImage v p
+makeImageWindowedVG !sz !(it, jt) !(wm, wn) getWindowPx getBorderPx =
+  VGImage m n $ VG.create generate
+  where
+    !(ib, jb) = (wm + it, wn + jt)
+    !(m, n) = checkDimsVG "makeImageWindowedVG" sz
+    !_ = checkDimsVG "makeImageWindowedVG (window size)" (wm, wn)
+    generate :: ST s ((VG.Mutable v) s p)
+    generate = do
+      when (it < 0 || it >= ib || jt < 0 || jt >= jb || ib > m || jb > n) $
+        error
+          ("Window index is outside the image dimensions. window start: " ++
+           show (it, jt) ++
+           " window size: " ++
+           show (wm, wn) ++ " image dimensions: " ++ show (m, n))
+      mv <- MVG.unsafeNew (m * n)
+      loopM_ 0 (< n) (+ 1) $ \ !j -> do
+        loopM_ 0 (< it) (+ 1) $ \ !i -> do
+          MVG.unsafeWrite mv (fromIx n (i, j)) (getBorderPx (i, j))
+        loopM_ ib (< m) (+ 1) $ \ !i -> do
+          MVG.unsafeWrite mv (fromIx n (i, j)) (getBorderPx (i, j))
+      loopM_ it (< ib) (+ 1) $ \ !i -> do
+        loopM_ 0 (< jt) (+ 1) $ \ !j -> do
+          MVG.unsafeWrite mv (fromIx n (i, j)) (getBorderPx (i, j))
+        loopM_ jt (< jb) (+ 1) $ \ !j -> do
+          MVG.unsafeWrite mv (fromIx n (i, j)) (getWindowPx (i, j))
+        loopM_ jb (< n) (+ 1) $ \ !j -> do
+          MVG.unsafeWrite mv (fromIx n (i, j)) (getBorderPx (i, j))
+      return mv
+    {-# INLINE generate #-}
+{-# INLINE makeImageWindowedVG #-}
 
-  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 #-}
+mapVG :: (VG.Vector v p1, VG.Vector v p)
+      => (p1 -> p) -> VGImage v p1 -> VGImage v p
+mapVG f (VGImage m n v) = VGImage m n (VG.map f v)
+{-# INLINE mapVG #-}
 
-  traverse2 !img1 !img2 getNewDims getNewPx =
-    makeImage (getNewDims (dims img1) (dims img2)) (getNewPx (index img1) (index img2))
-  {-# INLINE traverse2 #-}
+imapVG :: (VG.Vector v p1, VG.Vector v p)
+       => ((Int, Int) -> p1 -> p) -> VGImage v p1 -> VGImage v p
+imapVG f (VGImage m n v) = VGImage m n (VG.imap (\ !k !px -> f (toIx n k) px) v)
+{-# INLINE imapVG #-}
 
-  -- 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 #-}
+zipWithVG
+  :: ( VG.Vector v p1
+     , VG.Vector v p2
+     , VG.Vector v p
+     )
+  => (p1 -> p2 -> p)
+  -> VGImage v p1
+  -> VGImage v p2
+  -> VGImage v p
+zipWithVG f (VGImage 1 1 v1) (VGImage m n v2) =
+  let !px1 = VG.unsafeIndex v1 0
+  in VGImage m n (VG.map (f px1) v2)
+zipWithVG f (VGImage m n v1) (VGImage 1 1 v2) =
+  let !px2 = VG.unsafeIndex v2 0
+  in VGImage m n (VG.map (`f` px2) v1)
+zipWithVG f (VGImage m1 n1 v1) (VGImage m2 n2 v2) =
+  if m1 == m2 || n1 == n2
+    then VGImage m1 n1 (VG.zipWith f v1 v2)
+    else let !(m, n) = (min m1 m2, min n1 n2)
+             getPx !k =
+               let !ix = toIx n k
+                   !px1 = VG.unsafeIndex v1 (fromIx n1 ix)
+                   !px2 = VG.unsafeIndex v2 (fromIx n2 ix)
+               in f px1 px2
+         in VGImage m n $ VG.generate (m * n) getPx
+{-# INLINE zipWithVG #-}
 
-  -- TODO: add index verification and switch to VG.unsafeBackpermute
-  backpermute !(checkDims "(G 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 "(G 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 #-}
+izipWithVG
+  :: (VG.Vector v p1, VG.Vector v p2, VG.Vector v p)
+  => ((Int, Int) -> p1 -> p2 -> p)
+  -> VGImage v p1
+  -> VGImage v p2
+  -> VGImage v p
+izipWithVG f (VGImage 1 1 v1) (VGImage m n v2) =
+  let !px1 = VG.unsafeIndex v1 0
+  in VGImage m n (VG.imap (\ !k !px2 -> f (toIx n k) px1 px2) v2)
+izipWithVG f (VGImage m n v1) (VGImage 1 1 v2) =
+  let !px2 = VG.unsafeIndex v2 0
+  in VGImage m n (VG.imap (\ !k !px1 -> f (toIx n k) px1 px2) v1)
+izipWithVG f (VGImage m1 n1 v1) (VGImage m2 n2 v2) =
+  if m1 == m2 || n1 == n2
+    then VGImage m1 n1 (VG.izipWith (\ !k !px1 !px2 -> f (toIx n1 k) px1 px2) v1 v2)
+    else let !(m, n) = (min m1 m2, min n1 n2)
+             getPx !k =
+               let !ix = toIx n k
+                   !px1 = VG.unsafeIndex v1 (fromIx n1 ix)
+                   !px2 = VG.unsafeIndex v2 (fromIx n2 ix)
+               in f ix px1 px2
+         in VGImage m n $ VG.generate (m * n) getPx
+{-# INLINE izipWithVG #-}
 
-  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 (|*|) #-}
+unsafeIndexV :: VG.Vector v a => Int -> v a -> (Int, Int) -> a
+unsafeIndexV !n !v !ix = let !k = fromIx n ix in VG.unsafeIndex v k
+{-# INLINE unsafeIndexV #-}
 
-  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 #-}
+indexV :: VG.Vector v p => (Int, Int) -> v p -> (Int, Int) -> p
+indexV !sz@(_, n) !v !ix =
+  handleBorderIndex
+    (errorVG "indexV" ("Index out of bounds <" ++ show sz ++ ">: " ++ show ix))
+    sz
+    (unsafeIndexV n v)
+    ix
+{-# INLINE indexV #-}
 
-  compute (VImage m n v) = v `deepseq` (VImage m n v)
-  compute (VScalar px)   = px `seq` (VScalar px)
-  {-# INLINE compute #-}
 
-  toManifest = id
-  {-# INLINE toManifest #-}
 
-  toVector (VImage _ _ v) = VG.convert v
-  toVector (VScalar px)   = VG.singleton px
-  {-# INLINE[1] toVector #-}
+unsafeTraverseVG
+  :: (VG.Vector v p1, VG.Vector v p)
+  => VGImage v p1
+  -> ((Int, Int) -> (Int, Int))
+  -> (((Int, Int) -> p1) -> (Int, Int) -> p)
+  -> VGImage v p
+unsafeTraverseVG (VGImage m n v) getNewDims getNewPx =
+  makeImageVG (getNewDims (m, n)) (getNewPx (unsafeIndexV n v))
+{-# INLINE unsafeTraverseVG #-}
 
-  fromVector !(m, n) !v
-    | m * n /= VG.length v =
-       error $ "fromVector: m * n doesn't equal the length of a Vector: " ++
-               show m ++ " * " ++ show n ++ " /= " ++ show (VG.length v)
-    | m == 1 && n == 1     = VScalar (VG.unsafeIndex v 0)
-    | otherwise            = VImage m n v
-  {-# INLINE fromVector #-}
 
-instance (BaseArray (G r) cs e) => MArray (G r) cs e where
-  
-  data MImage s (G r) cs e = MVImage !Int !Int ((VG.Mutable (Vector (G 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 #-}
+traverseVG
+  :: (VG.Vector v p1, VG.Vector v p)
+  => VGImage v p1
+  -> ((Int, Int) -> (Int, Int))
+  -> (((Int, Int) -> p1) -> (Int, Int) -> p)
+  -> VGImage v p
+traverseVG (VGImage m n v) getNewDims getNewPx =
+  makeImageVG (getNewDims (m, n)) (getNewPx (indexV (m, n) v))
+{-# INLINE traverseVG #-}
 
-  deepSeqImage (VImage _ _ v) = 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
+unsafeTraverse2VG
+  :: (VG.Vector v p1, VG.Vector v p2, VG.Vector v p)
+  => VGImage v p1
+  -> VGImage v p2
+  -> ((Int, Int) -> (Int, Int) -> (Int, Int))
+  -> (((Int, Int) -> p1) -> ((Int, Int) -> p2) -> (Int, Int) -> p)
+  -> VGImage v p
+unsafeTraverse2VG (VGImage m1 n1 v1) (VGImage m2 n2 v2) getNewDims getNewPx =
+  makeImageVG
+    (getNewDims (m1, n1) (m2, n2))
+    (getNewPx (unsafeIndexV n1 v1) (unsafeIndexV n2 v2))
+{-# INLINE unsafeTraverse2VG #-}
 
-  foldr f !a (VImage _ _ v) = VG.foldr' f a v
-  foldr f !a (VScalar px)   = f px a
-  {-# INLINE foldr #-}
 
-  makeImageM !(checkDims "(G r).makeImageM" -> (m, n)) !f =
-    VImage m n <$> VG.generateM (m * n) (f . toIx n)
-  {-# INLINE makeImageM #-}
+traverse2VG
+  :: (VG.Vector v p1, VG.Vector v p2, VG.Vector v p)
+  => VGImage v p1
+  -> VGImage v p2
+  -> ((Int, Int) -> (Int, Int) -> (Int, Int))
+  -> (((Int, Int) -> p1) -> ((Int, Int) -> p2) -> (Int, Int) -> p)
+  -> VGImage v p
+traverse2VG (VGImage m1 n1 v1) (VGImage m2 n2 v2) getNewDims getNewPx =
+  makeImageVG
+    (getNewDims (m1, n1) (m2, n2))
+    (getNewPx (indexV (m1, n1) v1) (indexV (m2, n2) v2))
+{-# INLINE traverse2VG #-}
 
-  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_ #-}
+transposeVG :: (VG.Vector v Int, VG.Vector v p) =>
+               VGImage v p -> VGImage v p
+transposeVG (VGImage m n v) =
+  VGImage n m $ VG.unsafeBackpermute v $ VG.generate (m * n) (fromIx n . swapIx . toIx m)
+{-# INLINE transposeVG #-}
 
-  foldM f !a (VImage _ _ v) = VG.foldM' f a v
-  foldM f !a (VScalar px)    = f a px
-  {-# INLINE foldM #-}
+backpermuteWithCheckVG
+  :: (VG.Vector v Int, VG.Vector v p)
+  => ((Int, Int) -> (Int, Int) -> (Int, Int))
+  -> (Int, Int)
+  -> ((Int, Int) -> (Int, Int))
+  -> VGImage v p
+  -> VGImage v p
+backpermuteWithCheckVG checkIx !sz f (VGImage m' n' v) =
+  let !(m, n) = checkDimsVG "backpermuteWithCheckVG" sz
+  in VGImage m n $
+     VG.unsafeBackpermute v $
+     VG.generate (m * n) (fromIx n' . checkIx (m', n') . f . toIx n)
+{-# INLINE backpermuteWithCheckVG #-}
 
-  foldM_ f !a (VImage _ _ v) = VG.foldM'_ f a v
-  foldM_ f !a (VScalar px)    = void $ f a px
-  {-# INLINE foldM_ #-}
 
+unsafeBackpermuteVG
+  :: (VG.Vector v Int, VG.Vector v p)
+  => (Int, Int)
+  -> ((Int, Int) -> (Int, Int))
+  -> VGImage v p
+  -> VGImage v p
+unsafeBackpermuteVG = backpermuteWithCheckVG (const id)
+{-# INLINE unsafeBackpermuteVG #-}
 
-  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 #-}
+backpermuteVG
+  :: (VG.Vector v Int, VG.Vector v p)
+  => (Int, Int)
+  -> ((Int, Int) -> (Int, Int))
+  -> VGImage v p
+  -> VGImage v p
+backpermuteVG =
+  backpermuteWithCheckVG $ \ !sz !ix ->
+    let err =
+          errorVG
+            "backpermuteVG"
+            ("Index out of bounds <" ++ show sz ++ ">: " ++ show ix)
+    in handleBorderIndex err sz id ix
+{-# INLINE backpermuteVG #-}
 
-  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 #-}
+fromListsVG :: VG.Vector v p => [[p]] -> VGImage v p
+fromListsVG !ls =
+  if all (== n) (fmap length ls)
+    then VGImage m n . VG.fromList . concat $ ls
+    else errorVG "fromListsVG" "Inner lists are of different lengths."
+  where
+    (m, n) =
+      checkDimsVG "fromListsVG" (length ls, maybe 0 length $ listToMaybe ls)
+{-# NOINLINE fromListsVG #-}
 
-  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 #-}
+foldlVG :: VG.Vector v p =>
+           (a -> p -> a) -> a -> VGImage v p -> a
+foldlVG !f !px0 (VGImage _ _ v) = VG.foldl' f px0 v
+{-# INLINE foldlVG #-}
 
-  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 #-}
+foldrVG :: VG.Vector v p =>
+           (p -> a -> a) -> a -> VGImage v p -> a
+foldrVG !f !px0 (VGImage _ _ v) = VG.foldr' f px0 v
+{-# INLINE foldrVG #-}
 
-  swap (MVImage _ n mv) !ix1 !ix2 = MVG.swap mv (fromIx n ix1) (fromIx n ix2)
-  swap _                _    _    = return ()
-  {-# INLINE swap #-}
+
+ifoldlVG :: VG.Vector v p =>
+            (a -> (Int, Int) -> p -> a) -> a -> VGImage v p -> a
+ifoldlVG !f !px0 (VGImage _ n v) =
+  VG.ifoldl' (\ !acc !k -> f acc (toIx n k)) px0 v
+{-# INLINE ifoldlVG #-}
+
+
+toVectorVG :: (VG.Vector v p)
+           => VGImage v p -> v p
+toVectorVG (VGImage _ _ v) = v
+{-# INLINE toVectorVG #-}
+
+fromVectorVG :: VG.Vector v p =>
+                (Int, Int) -> v p -> VGImage v p
+fromVectorVG !(m, n) !v
+  | m * n == VG.length v = VGImage m n v
+  | otherwise =
+    errorVG "fromVectorVG" $
+    " image dimensions do not match the length of a vector: " ++
+    show m ++ " * " ++ show n ++ " /= " ++ show (VG.length v)
+{-# INLINE fromVectorVG #-}
+
+multVG :: ( VG.Vector v Int
+          , VG.Vector v p
+          , Num p
+          ) => VGImage v p -> VGImage v p -> VGImage v p
+multVG (VGImage m1 n1 v1) img2 =
+  if n1 /= m2
+    then errorVG "multVG" $
+         "Inner dimensions of images must agree, but received: " ++
+         show (m1, n1) ++ " X " ++ show (m2, n2)
+    else makeImageVG (m1, n2) getPx
+  where
+    VGImage n2 m2 v2 = transposeVG img2
+    getPx !(i, j) =
+      VG.sum $
+      VG.zipWith (*) (VG.slice (i * n1) n1 v1) (VG.slice (j * m2) m2 v2)
+    {-# INLINE getPx #-}
+{-# INLINE multVG #-}
+
+
+
+------ Manifest
+
+
+data MVGImage s v p = MVGImage !Int !Int (VG.Mutable v s p)
+
+
+unsafeIndexVG :: VG.Vector v p => VGImage v p -> (Int, Int) -> p
+unsafeIndexVG (VGImage _ n v) = VG.unsafeIndex v . fromIx n
+{-# INLINE unsafeIndexVG #-}
+
+
+makeImageMVG :: (Functor m, Monad m, VG.Vector v p) =>
+                (Int, Int) -> ((Int, Int) -> m p) -> m (VGImage v p)
+makeImageMVG !sz !f =
+  let !(m, n) = checkDimsVG "makeImageMVG" sz in
+    VGImage m n <$> VG.generateM (m * n) (f . toIx n)
+{-# INLINE makeImageMVG #-}
+
+mapMVG
+  :: (Functor m, Monad m, VG.Vector v a, VG.Vector v p) =>
+     (a -> m p) -> VGImage v a -> m (VGImage v p)
+mapMVG f (VGImage m n v) = VGImage m n <$> VG.mapM f v
+{-# INLINE mapMVG #-}
+
+mapM_VG
+  :: (Monad m, VG.Vector v a) => (a -> m b) -> VGImage v a -> m ()
+mapM_VG f (VGImage _ _ v) = VG.mapM_ f v
+{-# INLINE mapM_VG #-}
+
+foldMVG
+  :: (Monad m, VG.Vector v b) =>
+     (a -> b -> m a) -> a -> VGImage v b -> m a
+foldMVG f !a (VGImage _ _ v) = VG.foldM' f a v
+{-# INLINE foldMVG #-}
+
+foldM_VG
+  :: (Monad m, VG.Vector v b) =>
+     (a -> b -> m a) -> a -> VGImage v b -> m ()
+foldM_VG f !a (VGImage _ _ v) = VG.foldM'_ f a v
+{-# INLINE foldM_VG #-}
+
+
+mdimsVG :: MVGImage t2 t1 t -> (Int, Int)
+mdimsVG (MVGImage m n _) = (m, n)
+{-# INLINE mdimsVG #-}
+
+thawVG :: (VG.Mutable v1 ~ VG.Mutable v, Functor f, PrimMonad f, VG.Vector v1 p) =>
+     VGImage v1 p -> f (MVGImage (PrimState f) v p)
+thawVG (VGImage m n v) = MVGImage m n <$> VG.thaw v
+{-# INLINE thawVG #-}
+
+freezeVG :: (VG.Mutable t ~ VG.Mutable v, Functor f, PrimMonad f, VG.Vector v p) =>
+     MVGImage (PrimState f) t p -> f (VGImage v p)
+freezeVG (MVGImage m n mv) = VGImage m n <$> VG.freeze mv
+{-# INLINE freezeVG #-}
+
+newVG :: (Functor f, PrimMonad f, MVG.MVector (VG.Mutable v) p) =>
+     (Int, Int) -> f (MVGImage (PrimState f) v p)
+newVG (m, n) = MVGImage m n <$> MVG.new (m*n)
+{-# INLINE newVG #-}
+
+readVG :: (PrimMonad m, MVG.MVector (VG.Mutable t) a) =>
+     MVGImage (PrimState m) t a -> (Int, Int) -> m a
+readVG (MVGImage _ n mv) !ix = MVG.read mv (fromIx n ix)
+{-# INLINE readVG #-}
+
+writeVG :: (PrimMonad m, MVG.MVector (VG.Mutable t) a) =>
+     MVGImage (PrimState m) t a -> (Int, Int) -> a -> m ()
+writeVG (MVGImage _ n mv) !ix !px = MVG.write mv (fromIx n ix) px
+{-# INLINE writeVG #-}
+
+swapVG :: (PrimMonad m, MVG.MVector (VG.Mutable v) p) =>
+           MVGImage (PrimState m) v p -> (Int, Int) -> (Int, Int) -> m ()
+swapVG (MVGImage _ n mv) !ix1 !ix2 = MVG.swap mv (fromIx n ix1) (fromIx n ix2)
+{-# INLINE swapVG #-}
+
+
+errorVG :: String -> String -> a
+errorVG fName errMsg =
+  error $ "Graphics.Image.Interface.Vector.Generic." ++ fName ++ ": " ++ errMsg
+
+
+
+checkDimsVG :: String -> (Int, Int) -> (Int, Int)
+checkDimsVG fName = checkDims ("Graphics.Image.Interface.Vector.Generic." ++ fName)
+{-# INLINE checkDimsVG #-}
diff --git a/src/Graphics/Image/Interface/Vector/Storable.hs b/src/Graphics/Image/Interface/Vector/Storable.hs
--- a/src/Graphics/Image/Interface/Vector/Storable.hs
+++ b/src/Graphics/Image/Interface/Vector/Storable.hs
@@ -1,15 +1,14 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE BangPatterns          #-}
+{-# LANGUAGE CPP                   #-}
+{-# LANGUAGE ConstraintKinds       #-}
+{-# LANGUAGE DeriveDataTypeable    #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE RankNTypes            #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE UndecidableInstances  #-}
 -- |
 -- Module      : Graphics.Image.Interface.Vector.Storable
 -- Copyright   : (c) Alexey Kuleshevich 2017
@@ -22,14 +21,15 @@
   VS(..), Image(..)
   ) where
 
-import Prelude hiding (map, zipWith)
+import           Prelude                                 hiding (map, zipWith)
 #if !MIN_VERSION_base(4,8,0)
-import Data.Functor
+import           Data.Functor
 #endif
-import Data.Typeable (Typeable)
-import qualified Data.Vector.Storable as VS
-import Graphics.Image.Interface as I
-import Graphics.Image.Interface.Vector.Generic
+import           Control.DeepSeq                         (deepseq)
+import           Data.Typeable                           (Typeable)
+import qualified Data.Vector.Storable                    as VS
+import           Graphics.Image.Interface                as I
+import           Graphics.Image.Interface.Vector.Generic
 
 
 
@@ -43,9 +43,9 @@
   type SuperClass VS cs e =
     (ColorSpace cs e, VS.Storable (Pixel cs e))
 
-  newtype Image VS cs e = VSImage (Image (G VS) cs e)
+  newtype Image VS cs e = VSImage (VGImage VS.Vector (Pixel cs e))
 
-  dims (VSImage img) = dims img
+  dims (VSImage img) = dimsVG img
   {-# INLINE dims #-}
 
 
@@ -53,122 +53,121 @@
 instance (MArray VS cs e, BaseArray VS cs e) => Array VS cs e where
 
   type Manifest VS = VS
-  
+
   type Vector VS = VS.Vector
 
-  makeImage !sh = VSImage . makeImage sh
+  makeImage !sh = VSImage . makeImageVG sh
   {-# INLINE makeImage #-}
 
-  makeImageWindowed !sh !window f g = VSImage $ makeImageWindowed sh window f g
+  makeImageWindowed !sh !wIx !wSz f g = VSImage $ makeImageWindowedVG sh wIx wSz f g
   {-# INLINE makeImageWindowed #-}
-  
-  scalar = VSImage . scalar
+
+  scalar = VSImage . scalarVG
   {-# INLINE scalar #-}
 
-  index00 (VSImage img) = index00 img
+  index00 (VSImage img) = index00VG img
   {-# INLINE index00 #-}
-  
-  map f (VSImage img) = VSImage $ I.map f img
+
+  map f (VSImage img) = VSImage $ mapVG f img
   {-# INLINE map #-}
 
-  imap f (VSImage img) = VSImage $ I.imap f img
+  imap f (VSImage img) = VSImage $ imapVG f img
   {-# INLINE imap #-}
-  
-  zipWith f (VSImage img1) (VSImage img2) = VSImage $ I.zipWith f img1 img2
+
+  zipWith f (VSImage img1) (VSImage img2) = VSImage $ zipWithVG f img1 img2
   {-# INLINE zipWith #-}
 
-  izipWith f (VSImage img1) (VSImage img2) = VSImage $ I.izipWith f img1 img2
+  izipWith f (VSImage img1) (VSImage img2) = VSImage $ izipWithVG f img1 img2
   {-# INLINE izipWith #-}
 
-  traverse (VSImage img) f g = VSImage $ I.traverse img f g
+  traverse (VSImage img) f g = VSImage $ traverseVG img f g
   {-# INLINE traverse #-}
 
-  traverse2 (VSImage img1) (VSImage img2) f g = VSImage $ I.traverse2 img1 img2 f g
+  traverse2 (VSImage img1) (VSImage img2) f g = VSImage $ traverse2VG img1 img2 f g
   {-# INLINE traverse2 #-}
 
-  transpose (VSImage img) = VSImage $ I.transpose img
+  transpose (VSImage img) = VSImage $ transposeVG img
   {-# INLINE transpose #-}
 
-  backpermute !sz f (VSImage img) = VSImage $ I.backpermute sz f img
+  backpermute !sz f (VSImage img) = VSImage $ backpermuteVG sz f img
   {-# INLINE backpermute #-}
-  
-  fromLists = VSImage . I.fromLists
+
+  fromLists = VSImage . fromListsVG
   {-# INLINE fromLists #-}
 
-  fold f !px0 (VSImage img) = fold f px0 img
+  fold f !px0 (VSImage img) = foldlVG f px0 img
   {-# INLINE fold #-}
 
-  foldIx f !px0 (VSImage img) = foldIx f px0 img
+  foldIx f !px0 (VSImage img) = ifoldlVG f px0 img
   {-# INLINE foldIx #-}
 
-  (|*|) (VSImage img1) (VSImage img2) = VSImage (img1 |*| img2)
+  (|*|) (VSImage img1) (VSImage img2) = VSImage (multVG img1 img2)
   {-# INLINE (|*|) #-}
 
   eq (VSImage img1) (VSImage img2) = img1 == img2
   {-# INLINE eq #-}
 
-  compute (VSImage img) = VSImage (compute img)
+  compute (VSImage img) = img `deepseq` VSImage img
   {-# INLINE compute #-}
 
   toManifest = id
   {-# INLINE toManifest #-}
 
-  toVector (VSImage (VImage _ _ v)) = v
-  toVector (VSImage (VScalar px))   = VS.singleton px
+  toVector (VSImage img) = toVectorVG img
   {-# INLINE toVector #-}
 
-  fromVector !sz = VSImage . fromVector sz
+  fromVector !sz = VSImage . fromVectorVG sz
   {-# INLINE fromVector #-}
 
 
 instance BaseArray VS cs e => MArray VS cs e where
-  
-  newtype MImage s VS cs e = MVSImage (MImage s (G VS) cs e)
-                              
-  unsafeIndex (VSImage img) = unsafeIndex img
+
+  newtype MImage s VS cs e = MVSImage (MVGImage s VS.Vector (Pixel cs e))
+
+  unsafeIndex (VSImage img) = unsafeIndexVG img
   {-# INLINE unsafeIndex #-}
 
-  deepSeqImage (VSImage img) = deepSeqImage img
+  deepSeqImage (VSImage img) = deepseq img
   {-# INLINE deepSeqImage #-}
 
-  foldl f !px0 (VSImage img) = I.foldl f px0 img
+  foldl f !px0 (VSImage img) = foldlVG f px0 img
   {-# INLINE foldl #-}
 
-  foldr f !px0 (VSImage img) = I.foldr f px0 img
+  foldr f !px0 (VSImage img) = foldrVG f px0 img
   {-# INLINE foldr #-}
 
-  makeImageM !sh f = VSImage <$> makeImageM sh f
+  makeImageM !sh f = VSImage <$> makeImageMVG sh f
   {-# INLINE makeImageM #-}
 
-  mapM f (VSImage img) = VSImage <$> I.mapM f img
+  mapM f (VSImage img) = VSImage <$> mapMVG f img
   {-# INLINE mapM #-}
 
-  mapM_ f (VSImage img) = I.mapM_ f img
+  mapM_ f (VSImage img) = mapM_VG f img
   {-# INLINE mapM_ #-}
 
-  foldM f !px0 (VSImage img) = I.foldM f px0 img
+  foldM f !px0 (VSImage img) = foldMVG f px0 img
   {-# INLINE foldM #-}
 
-  foldM_ f !px0 (VSImage img) = I.foldM_ f px0 img
+  foldM_ f !px0 (VSImage img) = foldM_VG f px0 img
   {-# INLINE foldM_ #-}
 
-  mdims (MVSImage mimg) = mdims mimg
+  mdims (MVSImage mimg) = mdimsVG mimg
   {-# INLINE mdims #-}
 
-  thaw (VSImage img) = MVSImage <$> I.thaw img
+  thaw (VSImage img) = MVSImage <$> thawVG img
   {-# INLINE thaw #-}
 
-  freeze (MVSImage img) = VSImage <$> I.freeze img
+  freeze (MVSImage img) = VSImage <$> freezeVG img
   {-# INLINE freeze #-}
 
-  new !ix = MVSImage <$> I.new ix
+  new !ix = MVSImage <$> newVG ix
   {-# INLINE new #-}
 
-  read (MVSImage img) = I.read img
+  read (MVSImage img) = readVG img
   {-# INLINE read #-}
 
-  write (MVSImage img) = I.write img
+  write (MVSImage img) = writeVG img
   {-# INLINE write #-}
 
-  swap (MVSImage img) = I.swap img
+  swap (MVSImage img) = swapVG img
   {-# INLINE swap #-}
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
@@ -1,15 +1,14 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE BangPatterns          #-}
+{-# LANGUAGE CPP                   #-}
+{-# LANGUAGE ConstraintKinds       #-}
+{-# LANGUAGE DeriveDataTypeable    #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE RankNTypes            #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE UndecidableInstances  #-}
 -- |
 -- Module      : Graphics.Image.Interface.Vector.Unboxed
 -- Copyright   : (c) Alexey Kuleshevich 2017
@@ -22,15 +21,16 @@
   VU(..), VU.Unbox, Image(..)
   ) where
 
-import Prelude hiding (map, zipWith)
+import           Control.DeepSeq                          (deepseq)
+import           Prelude                                  hiding (map, zipWith)
 #if !MIN_VERSION_base(4,8,0)
-import Data.Functor
+import           Data.Functor
 #endif
-import Data.Typeable (Typeable)
-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()
+import           Data.Typeable                            (Typeable)
+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 ()
 
 
 
@@ -44,9 +44,9 @@
   type SuperClass VU cs e =
     (ColorSpace cs e, VU.Unbox (Components cs e))
 
-  newtype Image VU cs e = VUImage (Image (G VU) cs e)
+  newtype Image VU cs e = VUImage (VGImage VU.Vector (Pixel cs e))
 
-  dims (VUImage img) = dims img
+  dims (VUImage img) = dimsVG img
   {-# INLINE dims #-}
 
 
@@ -57,120 +57,119 @@
 
   type Vector VU = VU.Vector
 
-  makeImage !sh = VUImage . makeImage sh
+  makeImage !sh = VUImage . makeImageVG sh
   {-# INLINE makeImage #-}
 
-  makeImageWindowed !sh !window f g = VUImage $ makeImageWindowed sh window f g
+  makeImageWindowed !sh !wIx !wSz f g = VUImage $ makeImageWindowedVG sh wIx wSz f g
   {-# INLINE makeImageWindowed #-}
-  
-  scalar = VUImage . scalar
+
+  scalar = VUImage . scalarVG
   {-# INLINE scalar #-}
 
-  index00 (VUImage img) = index00 img
+  index00 (VUImage img) = index00VG img
   {-# INLINE index00 #-}
-  
-  map f (VUImage img) = VUImage $ I.map f img
+
+  map f (VUImage img) = VUImage $ mapVG f img
   {-# INLINE map #-}
 
-  imap f (VUImage img) = VUImage $ I.imap f img
+  imap f (VUImage img) = VUImage $ imapVG f img
   {-# INLINE imap #-}
-  
-  zipWith f (VUImage img1) (VUImage img2) = VUImage $ I.zipWith f img1 img2
+
+  zipWith f (VUImage img1) (VUImage img2) = VUImage $ zipWithVG f img1 img2
   {-# INLINE zipWith #-}
 
-  izipWith f (VUImage img1) (VUImage img2) = VUImage $ I.izipWith f img1 img2
+  izipWith f (VUImage img1) (VUImage img2) = VUImage $ izipWithVG f img1 img2
   {-# INLINE izipWith #-}
 
-  traverse (VUImage img) f g = VUImage $ I.traverse img f g
+  traverse (VUImage img) f g = VUImage $ traverseVG img f g
   {-# INLINE traverse #-}
 
-  traverse2 (VUImage img1) (VUImage img2) f g = VUImage $ I.traverse2 img1 img2 f g
+  traverse2 (VUImage img1) (VUImage img2) f g = VUImage $ traverse2VG img1 img2 f g
   {-# INLINE traverse2 #-}
 
-  transpose (VUImage img) = VUImage $ I.transpose img
+  transpose (VUImage img) = VUImage $ transposeVG img
   {-# INLINE transpose #-}
 
-  backpermute !sz f (VUImage img) = VUImage $ I.backpermute sz f img
+  backpermute !sz f (VUImage img) = VUImage $ backpermuteVG sz f img
   {-# INLINE backpermute #-}
-  
-  fromLists = VUImage . I.fromLists
-  {-# INLINE fromLists #-}
 
-  fold f !px0 (VUImage img) = fold f px0 img
+  fromLists = VUImage . fromListsVG
+  {-# NOINLINE fromLists #-}
+
+  fold f !px0 (VUImage img) = foldlVG f px0 img
   {-# INLINE fold #-}
 
-  foldIx f !px0 (VUImage img) = foldIx f px0 img
+  foldIx f !px0 (VUImage img) = ifoldlVG f px0 img
   {-# INLINE foldIx #-}
 
-  (|*|) (VUImage img1) (VUImage img2) = VUImage (img1 |*| img2)
+  (|*|) (VUImage img1) (VUImage img2) = VUImage (multVG img1 img2)
   {-# INLINE (|*|) #-}
 
   eq (VUImage img1) (VUImage img2) = img1 == img2
   {-# INLINE eq #-}
 
-  compute (VUImage img) = VUImage (compute img)
+  compute (VUImage img) = img `deepseq` VUImage img
   {-# INLINE compute #-}
 
   toManifest = id
   {-# INLINE toManifest #-}
 
-  toVector (VUImage (VImage _ _ v)) = v
-  toVector (VUImage (VScalar px))   = VU.singleton px
+  toVector (VUImage img) = toVectorVG img
   {-# INLINE toVector #-}
 
-  fromVector !sz = VUImage . fromVector sz
+  fromVector !sz = VUImage . fromVectorVG sz
   {-# INLINE fromVector #-}
 
 
 instance BaseArray VU cs e => MArray VU cs e where
-  
-  newtype MImage s VU cs e = MVUImage (MImage s (G VU) cs e)
-                              
-  unsafeIndex (VUImage img) = unsafeIndex img
+
+  newtype MImage s VU cs e = MVUImage (MVGImage s VU.Vector (Pixel cs e))
+
+  unsafeIndex (VUImage img) = unsafeIndexVG img
   {-# INLINE unsafeIndex #-}
 
-  deepSeqImage (VUImage img) = deepSeqImage img
+  deepSeqImage (VUImage img) = deepseq img
   {-# INLINE deepSeqImage #-}
 
-  foldl f !px0 (VUImage img) = I.foldl f px0 img
+  foldl f !px0 (VUImage img) = foldlVG f px0 img
   {-# INLINE foldl #-}
 
-  foldr f !px0 (VUImage img) = I.foldr f px0 img
+  foldr f !px0 (VUImage img) = foldrVG f px0 img
   {-# INLINE foldr #-}
 
-  makeImageM !sh f = VUImage <$> makeImageM sh f
+  makeImageM !sh f = VUImage <$> makeImageMVG sh f
   {-# INLINE makeImageM #-}
 
-  mapM f (VUImage img) = VUImage <$> I.mapM f img
+  mapM f (VUImage img) = VUImage <$> mapMVG f img
   {-# INLINE mapM #-}
 
-  mapM_ f (VUImage img) = I.mapM_ f img
+  mapM_ f (VUImage img) = mapM_VG f img
   {-# INLINE mapM_ #-}
 
-  foldM f !px0 (VUImage img) = I.foldM f px0 img
+  foldM f !px0 (VUImage img) = foldMVG f px0 img
   {-# INLINE foldM #-}
 
-  foldM_ f !px0 (VUImage img) = I.foldM_ f px0 img
+  foldM_ f !px0 (VUImage img) = foldM_VG f px0 img
   {-# INLINE foldM_ #-}
 
-  mdims (MVUImage mimg) = mdims mimg
+  mdims (MVUImage mimg) = mdimsVG mimg
   {-# INLINE mdims #-}
 
-  thaw (VUImage img) = MVUImage <$> I.thaw img
+  thaw (VUImage img) = MVUImage <$> thawVG img
   {-# INLINE thaw #-}
 
-  freeze (MVUImage img) = VUImage <$> I.freeze img
+  freeze (MVUImage img) = VUImage <$> freezeVG img
   {-# INLINE freeze #-}
 
-  new !ix = MVUImage <$> I.new ix
+  new !ix = MVUImage <$> newVG ix
   {-# INLINE new #-}
 
-  read (MVUImage img) = I.read img
+  read (MVUImage img) = readVG img
   {-# INLINE read #-}
 
-  write (MVUImage img) = I.write img
+  write (MVUImage img) = writeVG img
   {-# INLINE write #-}
 
-  swap (MVUImage img) = I.swap img
+  swap (MVUImage img) = swapVG img
   {-# INLINE swap #-}
 
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
@@ -16,6 +16,8 @@
   module Graphics.Image.Processing.Interpolation,
   -- * Convolution
   module Graphics.Image.Processing.Convolution,
+  -- * Filters
+  module Graphics.Image.Processing.Filter,
   -- * Tools
   Border(..), pixelGrid
   ) where
@@ -28,6 +30,7 @@
 import Graphics.Image.Processing.Convolution
 import Graphics.Image.Processing.Geometric
 import Graphics.Image.Processing.Interpolation
+import Graphics.Image.Processing.Filter
 
 
 
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
@@ -1,15 +1,15 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE BangPatterns            #-}
+{-# LANGUAGE CPP                     #-}
+{-# LANGUAGE FlexibleContexts        #-}
+{-# LANGUAGE FlexibleInstances       #-}
+{-# LANGUAGE FunctionalDependencies  #-}
+{-# LANGUAGE MultiParamTypeClasses   #-}
 #if __GLASGOW_HASKELL__ >= 800
-  {-# LANGUAGE UndecidableSuperClasses #-}
+{-# LANGUAGE UndecidableSuperClasses #-}
 #endif
 -- |
 -- Module      : Graphics.Image.Processing.Binary
--- Copyright   : (c) Alexey Kuleshevich 2016
+-- Copyright   : (c) Alexey Kuleshevich 2017
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -18,27 +18,29 @@
 module Graphics.Image.Processing.Binary (
   -- * Construction
   toImageBinaryUsing, toImageBinaryUsing2,
-  thresholdWith, compareWith,
-  -- * Bitwise operations
-  or, and, (.&&.), (.||.), invert,
+  threshold, threshold2,
+  thresholdWith, thresholdWith2, compareWith,
   -- * Thresholding
   Thresholding(..),
+  -- * Bitwise operations
+  or, and, (!&&!), (!||!), (.&&.), (.||.), invert, disjunction, conjunction,
   -- * Binary Morphology
   -- $morphology
   erode, dialate, open, close
   ) where
 
-import Prelude hiding (map, zipWith, and, or)
-import Data.Bits
-import Graphics.Image.Interface
-import Graphics.Image.ColorSpace
-import Graphics.Image.Processing.Convolution
-
-import qualified Data.Foldable as F
+import           Control.Applicative
+import           Data.Bits
+import qualified Data.Foldable                           as F
+import           Graphics.Image.ColorSpace
+import           Graphics.Image.Interface                as I
+import           Graphics.Image.Processing.Convolution
+import           Graphics.Image.Utils                    ((.:), (.:!))
+import           Prelude                                 as P hiding (and, or)
 
-infix  4  .==., ./=., .<., .<=., .>=., .>.
-infixr 3  .&&.
-infixr 2  .||.
+infix  4  .==., ./=., .<., .<=., .>=., .>., !==!, !/=!, !<!, !<=!, !>=!, !>!
+infixr 3  .&&., !&&!
+infixr 2  .||., !||!
 
 
 
@@ -50,114 +52,181 @@
 -- >>> frog .==. PixelY 0    -- (or: PixelY 0 .==. frog)
 -- >>> frog .<. flipH frog   -- (or: flipH frog .>. frog)
 --
-class Array arr Binary Bit => Thresholding a b arr | a b -> arr where
-  (.==.) :: Array arr cs e => a cs e -> b cs e -> Image arr Binary Bit
-  (./=.) :: Array arr cs e => a cs e -> b cs e -> Image arr Binary Bit
-  (.<.)  :: (Ord (Pixel cs e), Array arr cs e) => a cs e -> b cs e -> Image arr Binary Bit
-  (.<=.) :: (Ord (Pixel cs e), Array arr cs e) => a cs e -> b cs e -> Image arr Binary Bit
-  (.>.)  :: (Ord (Pixel cs e), Array arr cs e) => a cs e -> b cs e -> Image arr Binary Bit
-  (.>=.) :: (Ord (Pixel cs e), Array arr cs e) => a cs e -> b cs e -> Image arr Binary Bit
+class Thresholding a b arr | a b -> arr where
+  (!==!) :: (Applicative (Pixel cs), Array arr cs e, Array arr cs Bit) =>
+            a cs e -> b cs e -> Image arr cs Bit
+  (!/=!) :: (Applicative (Pixel cs), Array arr cs e, Array arr cs Bit) =>
+            a cs e -> b cs e -> Image arr cs Bit
+  (!<!)  :: (Ord e, Applicative (Pixel cs), Array arr cs e, Array arr cs Bit) =>
+            a cs e -> b cs e -> Image arr cs Bit
+  (!<=!) :: (Ord e, Applicative (Pixel cs), Array arr cs e, Array arr cs Bit) =>
+            a cs e -> b cs e -> Image arr cs Bit
+  (!>!)  :: (Ord e, Applicative (Pixel cs), Array arr cs e, Array arr cs Bit) =>
+            a cs e -> b cs e -> Image arr cs Bit
+  (!>=!) :: (Ord e, Applicative (Pixel cs), Array arr cs e, Array arr cs Bit) =>
+            a cs e -> b cs e -> Image arr cs Bit
+  (.==.) :: (Array arr cs e, Array arr X Bit) => a cs e -> b cs e -> Image arr X Bit
+  (./=.) :: (Array arr cs e, Array arr X Bit) => a cs e -> b cs e -> Image arr X Bit
+  (.<.)  :: (Ord (Pixel cs e), Array arr cs e, Array arr X Bit) =>
+            a cs e -> b cs e -> Image arr X Bit
+  (.<=.) :: (Ord (Pixel cs e), Array arr cs e, Array arr X Bit) =>
+            a cs e -> b cs e -> Image arr X Bit
+  (.>.)  :: (Ord (Pixel cs e), Array arr cs e, Array arr X Bit) =>
+            a cs e -> b cs e -> Image arr X Bit
+  (.>=.) :: (Ord (Pixel cs e), Array arr cs e, Array arr X Bit) =>
+            a cs e -> b cs e -> Image arr X Bit
 
 
 
-instance Array arr Binary Bit => Thresholding (Image arr) (Image arr) arr where
+instance Thresholding (Image arr) (Image arr) arr where
   (.==.) = toImageBinaryUsing2 (==)
   {-# INLINE (.==.) #-}
-  
   (./=.) = toImageBinaryUsing2 (/=)
   {-# INLINE (./=.) #-}
-  
   (.<.)  = toImageBinaryUsing2 (<)
   {-# INLINE (.<.) #-}
-  
   (.<=.) = toImageBinaryUsing2 (<=)
   {-# INLINE (.<=.) #-}
-  
   (.>.)  = toImageBinaryUsing2 (>)
   {-# INLINE (.>.) #-}
-  
   (.>=.) = toImageBinaryUsing2 (>=)
   {-# INLINE (.>=.) #-}
-  
+  (!==!) = threshold2 (pure (==))
+  {-# INLINE (!==!) #-}
+  (!/=!) = threshold2 (pure (/=))
+  {-# INLINE (!/=!) #-}
+  (!<!)  = threshold2 (pure (<))
+  {-# INLINE (!<!) #-}
+  (!<=!) = threshold2 (pure (<=))
+  {-# INLINE (!<=!) #-}
+  (!>!)  = threshold2 (pure (>))
+  {-# INLINE (!>!) #-}
+  (!>=!) = threshold2 (pure (>=))
+  {-# INLINE (!>=!) #-}
 
-instance Array arr Binary Bit => Thresholding Pixel (Image arr) arr where
+
+instance Array arr X Bit => Thresholding Pixel (Image arr) arr where
   (.==.) !px = toImageBinaryUsing (==px)
   {-# INLINE (.==.) #-}
-  
   (./=.) !px = toImageBinaryUsing (/=px)
   {-# INLINE (./=.) #-}
-  
   (.<.)  !px = toImageBinaryUsing (< px)
   {-# INLINE (.<.) #-}
-  
   (.<=.) !px = toImageBinaryUsing (<=px)
   {-# INLINE (.<=.) #-}
-  
   (.>.)  !px = toImageBinaryUsing (> px)
   {-# INLINE (.>.) #-}
-  
   (.>=.) !px = toImageBinaryUsing (>=px)
   {-# INLINE (.>=.) #-}
-  
+  (!==!) !px = threshold ((==) <$> px)
+  {-# INLINE (!==!) #-}
+  (!/=!) !px = threshold ((/=) <$> px)
+  {-# INLINE (!/=!) #-}
+  (!<!) !px  = threshold ((<) <$> px)
+  {-# INLINE (!<!) #-}
+  (!<=!) !px = threshold ((<=) <$> px)
+  {-# INLINE (!<=!) #-}
+  (!>!) !px  = threshold ((>) <$> px)
+  {-# INLINE (!>!) #-}
+  (!>=!) !px = threshold ((>=) <$> px)
+  {-# INLINE (!>=!) #-}
 
-instance Array arr Binary Bit => Thresholding (Image arr) Pixel arr where
+
+instance Array arr X Bit => Thresholding (Image arr) Pixel arr where
   (.==.) !img !px = toImageBinaryUsing (==px) img
   {-# INLINE (.==.) #-}
-  
   (./=.) !img !px = toImageBinaryUsing (/=px) img
   {-# INLINE (./=.) #-}
-  
   (.<.)  !img !px = toImageBinaryUsing (< px) img
   {-# INLINE (.<.) #-}
-  
   (.<=.) !img !px = toImageBinaryUsing (<=px) img
   {-# INLINE (.<=.) #-}
-  
   (.>.)  !img !px = toImageBinaryUsing (> px) img
   {-# INLINE (.>.) #-}
-  
   (.>=.) !img !px = toImageBinaryUsing (>=px) img
   {-# INLINE (.>=.) #-}
+  (!==!) !img !px = threshold ((==) <$> px) img
+  {-# INLINE (!==!) #-}
+  (!/=!) !img !px = threshold ((/=) <$> px) img
+  {-# INLINE (!/=!) #-}
+  (!<!)  !img !px = threshold ((<) <$> px) img
+  {-# INLINE (!<!) #-}
+  (!<=!) !img !px = threshold ((<=) <$> px) img
+  {-# INLINE (!<=!) #-}
+  (!>!)  !img !px = threshold ((>) <$> px) img
+  {-# INLINE (!>!) #-}
+  (!>=!) !img !px = threshold ((>=) <$> px) img
+  {-# INLINE (!>=!) #-}
 
 
--- | Pixel wise @AND@ operator on binary images. 
-(.&&.) :: Array arr Binary Bit =>
-          Image arr Binary Bit -> Image arr Binary Bit -> Image arr Binary Bit
-(.&&.) = zipWith (*)
+-- | Pixel wise @AND@ operator on binary images. Unlike `!&&!` this operator
+-- will also @AND@ pixel componenets.
+(.&&.) :: (Array arr cs Bit, Array arr X Bit) =>
+          Image arr cs Bit -> Image arr cs Bit -> Image arr X Bit
+(.&&.) = squashWith2 ((.&.) .: (.&.)) one
 {-# INLINE (.&&.) #-}
 
--- | Pixel wise @OR@ operator on binary images.
-(.||.) :: Array arr Binary Bit =>
-          Image arr Binary Bit -> Image arr Binary Bit -> Image arr Binary Bit
-(.||.) = zipWith (+)
+-- | Pixel wise @OR@ operator on binary images. Unlike `!||!` this operator
+-- will also @OR@ pixel componenets.
+(.||.) :: (Array arr cs Bit, Array arr X Bit) =>
+          Image arr cs Bit -> Image arr cs Bit -> Image arr X Bit
+(.||.) = squashWith2 ((.|.) .: (.|.)) zero
 {-# INLINE (.||.) #-}
 
 
+-- | Pixel wise @AND@ operator on binary images.
+(!&&!) :: Array arr cs Bit =>
+          Image arr cs Bit -> Image arr cs Bit -> Image arr cs Bit
+(!&&!) = I.zipWith (liftPx2 (.&.))
+{-# INLINE (!&&!) #-}
+
+-- | Pixel wise @OR@ operator on binary images.
+(!||!) :: Array arr cs Bit =>
+          Image arr cs Bit -> Image arr cs Bit -> Image arr cs Bit
+(!||!) = I.zipWith (liftPx2 (.|.))
+{-# INLINE (!||!) #-}
+
+
 -- | Complement each pixel in a binary image
-invert :: Array arr Binary Bit => Image arr Binary Bit -> Image arr Binary Bit
-invert = map complement
+invert :: Array arr cs Bit => Image arr cs Bit -> Image arr cs Bit
+invert = I.map (liftPx complement)
 {-# INLINE invert #-}
 
 
 -- | Construct a binary image using a predicate from a source image.
-toImageBinaryUsing :: (Array arr cs e, Array arr Binary Bit) =>
+toImageBinaryUsing :: (Array arr cs e, Array arr X Bit) =>
                       (Pixel cs e -> Bool) -- ^ Predicate
                    -> Image arr cs e -- ^ Source image.
-                   -> Image arr Binary Bit
-toImageBinaryUsing f = map (fromBool . f)
+                   -> Image arr X Bit
+toImageBinaryUsing f = I.map (fromBool . f)
 {-# INLINE toImageBinaryUsing #-}
 
 
 -- | Construct a binary image using a predicate from two source images.
-toImageBinaryUsing2 :: (Array arr cs e, Array arr Binary Bit) =>
+toImageBinaryUsing2 :: (Array arr cs e, Array arr X Bit) =>
                        (Pixel cs e -> Pixel cs e -> Bool) -- ^ Predicate
                     -> Image arr cs e -- ^ First source image.
                     -> Image arr cs e -- ^ Second source image.
-                    -> Image arr Binary Bit
-toImageBinaryUsing2 f =  zipWith (((.).(.)) fromBool f)
+                    -> Image arr X Bit
+toImageBinaryUsing2 f = I.zipWith (fromBool .:! f)
 {-# INLINE toImageBinaryUsing2 #-}
 
 
+threshold :: (Applicative (Pixel cs), Array arr cs e, Array arr cs Bit) =>
+             Pixel cs (e -> Bool) -> Image arr cs e -> Image arr cs Bit
+threshold fPx = I.map (fmap bool2bit . (fPx <*>))
+{-# INLINE threshold #-}
+
+
+threshold2 :: (Applicative (Pixel cs), Array arr cs e', Array arr cs e, Array arr cs Bit) =>
+              Pixel cs (e' -> e -> Bool)
+           -> Image arr cs e'
+           -> Image arr cs e
+           -> Image arr cs Bit
+threshold2 fPx = I.zipWith (\ !px1 !px2 -> bool2bit <$> (fPx <*> px1 <*> px2))
+{-# INLINE threshold2 #-}
+
+
 -- | Threshold a source image with an applicative pixel.
 --
 -- >>> yield <- readImageRGB VU "images/yield.jpg"
@@ -166,36 +235,63 @@
 -- <<images/yield.jpg>> <<images/yield_bin.png>>
 --
 thresholdWith :: (Applicative (Pixel cs), Foldable (Pixel cs),
-                  Array arr cs e, Array arr Binary Bit) =>
+                  Array arr cs e, Array arr X Bit) =>
                  Pixel cs (e -> Bool)
                  -- ^ Pixel containing a thresholding function per channel.
               -> Image arr cs e -- ^ Source image.
-              -> Image arr Binary Bit
-thresholdWith f = map (fromBool . F.and . (f <*>))
+              -> Image arr X Bit
+thresholdWith fPx = I.map (fromBool . F.and . (fPx <*>))
 {-# INLINE thresholdWith #-}
 
 
 -- | Compare two images with an applicative pixel. Works just like
 -- 'thresholdWith', but on two images.
+thresholdWith2 :: (Applicative (Pixel cs), Foldable (Pixel cs),
+                   Array arr cs e1, Array arr cs e2, Array arr X Bit) =>
+                  Pixel cs (e1 -> e2 -> Bool)
+                  -- ^ Pixel containing a comparing function per channel.
+               -> Image arr cs e1 -- ^ First image.
+               -> Image arr cs e2 -- ^ second image.
+               -> Image arr X Bit
+thresholdWith2 fPx = I.zipWith (\ !px1 !px2 -> (fromBool . F.and) (fPx <*> px1 <*> px2))
+{-# INLINE thresholdWith2 #-}
+-- I.map (\ !px -> PixelX $ foldlPx (.&.) one $ (fmap (bool2bit .) fPx <*> px))
+
+-- | Compare two images with an applicative pixel. Works just like
+-- 'thresholdWith', but on two images.
 compareWith :: (Applicative (Pixel cs), Foldable (Pixel cs),
-                Array arr cs e1, Array arr cs e2, Array arr Binary Bit) =>
+                Array arr cs e1, Array arr cs e2, Array arr X Bit) =>
                Pixel cs (e1 -> e2 -> Bool)
                -- ^ Pixel containing a comparing function per channel.
             -> Image arr cs e1 -- ^ First image.
             -> Image arr cs e2 -- ^ second image.
-            -> Image arr Binary Bit
-compareWith !f = zipWith (\ !px1 !px2 -> fromBool . F.and $ (f <*> px1 <*> px2))
+            -> Image arr X Bit
+compareWith = thresholdWith2
 {-# INLINE compareWith #-}
+{-# DEPRECATED compareWith "Use `thresholdWith2` instead." #-}
 
 
+-- | Join each component of a pixel with a binary @`.|.`@ operator.
+disjunction :: (Array arr cs Bit, Array arr X Bit) =>
+               Image arr cs Bit -> Image arr X Bit
+disjunction = squashWith (.|.) zero
+{-# INLINE disjunction #-}
+
+
+-- | Join each component of a pixel with a binary @`.&.`@ operator.
+conjunction :: (Array arr cs Bit, Array arr X Bit) =>
+               Image arr cs Bit -> Image arr X Bit
+conjunction = squashWith (.&.) one
+{-# INLINE conjunction #-}
+
 -- | Disjunction of all pixels in a Binary image
-or :: Array arr Binary Bit => Image arr Binary Bit -> Bool
+or :: Array arr X Bit => Image arr X Bit -> Bool
 or = isOn . fold (.|.) off
 {-# INLINE or #-}
 
 
 -- | Conjunction of all pixels in a Binary image
-and :: Array arr Binary Bit => Image arr Binary Bit -> Bool
+and :: Array arr X Bit => Image arr X Bit -> Bool
 and = isOn . fold (.&.) on
 {-# INLINE and #-}
 
@@ -206,7 +302,7 @@
 element is always at it's center, eg. @(1,1)@ for the one below.
 
 @
-figure :: Image VU Binary Bit
+figure :: Image VU X 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],
@@ -224,7 +320,7 @@
                     [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 :: Image VU X Bit
 struct = fromLists [[0,1,0],[1,1,0],[0,1,0]]
 @
 -}
@@ -236,10 +332,10 @@
 --
 -- <<images/figure.png>> eroded with <<images/struct.png>> is <<images/figure_erode.png>>
 --
-erode :: Array arr Binary Bit =>
-         Image arr Binary Bit -- ^ Structuring element.
-      -> Image arr Binary Bit -- ^ Binary source image.
-      -> Image arr Binary Bit
+erode :: Array arr X Bit =>
+         Image arr X Bit -- ^ Structuring element.
+      -> Image arr X Bit -- ^ Binary source image.
+      -> Image arr X Bit
 erode !struc !img = invert $ convolve (Fill on) struc (invert img)
 {-# INLINE erode #-}
 
@@ -250,10 +346,10 @@
 --
 -- <<images/figure.png>> dialated with <<images/struct.png>> is <<images/figure_dialate.png>>
 --
-dialate :: Array arr Binary Bit =>
-           Image arr Binary Bit -- ^ Structuring element.
-        -> Image arr Binary Bit -- ^ Binary source image.
-        -> Image arr Binary Bit
+dialate :: Array arr X Bit =>
+           Image arr X Bit -- ^ Structuring element.
+        -> Image arr X Bit -- ^ Binary source image.
+        -> Image arr X Bit
 dialate !struc !img = convolve (Fill off) struc img
 {-# INLINE dialate #-}
 
@@ -264,11 +360,11 @@
 --
 -- <<images/figure.png>> opened with <<images/struct.png>> is <<images/figure_open.png>>
 --
-open :: Array arr Binary Bit =>
-        Image arr Binary Bit -- ^ Structuring element.
-     -> Image arr Binary Bit -- ^ Binary source image.
-     -> Image arr Binary Bit
-open struc = dialate struc . erode struc
+open :: Array arr X Bit =>
+        Image arr X Bit -- ^ Structuring element.
+     -> Image arr X Bit -- ^ Binary source image.
+     -> Image arr X Bit
+open !struc = dialate struc . erode struc
 {-# INLINE open #-}
 
 
@@ -278,11 +374,10 @@
 --
 -- <<images/figure.png>> closed with <<images/struct.png>> is <<images/figure_close.png>>
 --
-close :: Array arr Binary Bit =>
-         Image arr Binary Bit -- ^ Structuring element.
-      -> Image arr Binary Bit -- ^ Binary source image.
-      -> Image arr Binary Bit
-close struc = erode struc . dialate struc
+close :: Array arr X Bit =>
+         Image arr X Bit -- ^ Structuring element.
+      -> Image arr X Bit -- ^ Binary source image.
+      -> Image arr X Bit
+close !struc = erode struc . dialate struc
 {-# INLINE close #-}
-
 
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
@@ -15,8 +15,6 @@
   mkPolarI, cisI, polarI, magnitudeI, phaseI,
   -- * Conjugate
   conjugateI,
-  -- * Processing
-  makeFilter, applyFilter,
   -- ** Fourier Transform
   fft, ifft
   ) where
@@ -92,30 +90,3 @@
               Image arr cs (Complex e) -> Image arr cs (Complex e)
 conjugateI = map conjugate
 {-# INLINE conjugateI #-}
-
-
--- | Make a filter by using a function that works around a regular @(x, y)@
--- coordinate system.
-makeFilter :: (Array arr cs e, RealFloat e) =>
-              (Int, Int)
-              -- ^ Dimensions of the filter. Both @m@ and @n@ have to be powers
-              -- of @2@, i.e. @m == 2^k@, where @k@ is some integer.
-           -> ((Int, Int) -> Pixel cs e) -> Image arr cs e
-makeFilter !(m, n) !getPx 
-  | isPowerOfTwo m && isPowerOfTwo n = makeImage (m, n) getPx'
-  | otherwise = error " "
-  where getPx' (i, j) = getPx (if i < (m `div` 2) then i else i - m,
-                               if j < (n `div` 2) then j else j - n)
-        {-# INLINE getPx' #-}
-{-# INLINE makeFilter #-}
-
-
--- | Apply a filter to an image created by 'makeFilter'.
-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 = realPartI . ifft $ (fft (img !+! 0) * (filt !+! filt))
-{-# INLINE applyFilter #-}
-
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
@@ -1,11 +1,11 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE BangPatterns          #-}
+{-# LANGUAGE ConstraintKinds       #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
 -- |
 -- Module      : Graphics.Image.Processing.Complex.Fourier
--- Copyright   : (c) Alexey Kuleshevich 2016
+-- Copyright   : (c) Alexey Kuleshevich 2017
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -15,15 +15,11 @@
   fft, ifft, isPowerOfTwo
   ) where
 
-#if MIN_VERSION_base(4,8,0)
-import Prelude hiding (map, traverse)
-#else
-import Prelude hiding (map)
-#endif
-import Data.Bits ((.&.))
-import Graphics.Image.Interface
-import Graphics.Image.ColorSpace.Complex
-import Graphics.Image.Processing.Geometric (leftToRight)
+import           Data.Bits                           ((.&.))
+import           Graphics.Image.ColorSpace.Complex
+import           Graphics.Image.Interface            as I
+import           Graphics.Image.Processing.Geometric (leftToRight)
+import           Prelude                             as P
 
 
 data Mode = Forward
@@ -36,7 +32,7 @@
        Image arr cs (Complex e)
     -> Image arr cs (Complex e)
 fft = fft2d Forward
-{-# INLINE fft #-}
+{-# INLINEABLE fft #-}
 
 
 -- | Inverse Fast Fourier Transform
@@ -46,7 +42,7 @@
         Image arr cs (Complex e)
      -> Image arr cs (Complex e)
 ifft = fft2d Inverse
-{-# INLINE ifft #-}
+{-# INLINEABLE ifft #-}
 
 
 signOfMode :: Num a => Mode -> a
@@ -68,44 +64,66 @@
          Mode
       -> Image arr cs (Complex e)
       -> Image arr cs (Complex e)
-fft2d mode img =
+fft2d !mode !img =
   let !(m, n) = dims img
-      !sign   = signOfMode mode
-      !scale  = fromIntegral (m * n) 
+      !sign = signOfMode mode
+      !factor = fromIntegral (m * n)
   in if not (isPowerOfTwo m && isPowerOfTwo n)
-     then error $ unlines
-          [ "fft"
-          , "  Array dimensions must be powers of two,"
-          , "  but the provided image is " ++ show img ++ "." ]
-     else case mode of
-       Forward -> fftGeneral sign $ fftGeneral sign img
-       Inverse -> map (/ scale) $ fftGeneral sign $ fftGeneral sign img
+       then error $
+            unlines
+              [ "fft"
+              , "  Array dimensions must be powers of two,"
+              , "  but the provided image is " ++ show img ++ "."
+              ]
+       else compute $
+            case mode of
+              Forward -> fftGeneral sign $ fftGeneral sign img
+              Inverse ->
+                I.map (/ factor) $ fftGeneral sign $ fftGeneral sign img
 {-# INLINE fft2d #-}
 
 
-fftGeneral :: (Applicative (Pixel cs),
-               Array arr cs (Complex e), ColorSpace cs e, 
-               Floating (Pixel cs e), RealFloat e) =>
-              Pixel cs e
-           -> Image arr cs (Complex e)
-           -> Image arr cs (Complex e)
-fftGeneral !sign !img = transpose $ go n 0 1 where
-  imgM = toManifest img
-  !(m, n) = dims img
-  go !len !offset !stride
-    | len == 2 = makeImage (m, 2) swivel
-    | otherwise = combine len 
-                  (go (len `div` 2) offset            (stride * 2))
-                  (go (len `div` 2) (offset + stride) (stride * 2))
-    where
-      swivel (m', j) = case j of
-        0 -> index imgM (m', offset) + index imgM (m', offset + stride)
-        1 -> index imgM (m', offset) - index imgM (m', offset + stride)
-        _ -> error "FFT: Image must have exactly 2 columns. Please, report this bug."
-      combine !len' evens odds =  
-        let odds' = traverse odds id
-                    (\getPx (i, j) -> twiddle sign j len' * getPx (i, j)) 
-        in leftToRight (evens + odds') (evens - odds')
+fftGeneral
+  :: forall arr cs e.
+     ( Applicative (Pixel cs)
+     , Array arr cs (Complex e)
+     , ColorSpace cs e
+     , Floating (Pixel cs e)
+     , RealFloat e
+     )
+  => Pixel cs e -> Image arr cs (Complex e) -> Image arr cs (Complex e)
+fftGeneral !sign !img = transpose $ go n 0 1
+  where
+    imgM :: Image (Manifest arr) cs (Complex e)
+    !imgM = toManifest img
+    !(m, n) = dims img
+    go !len !offset !stride
+      | len == 2 = compute $ makeImage (m, 2) swivel
+      | otherwise =
+        compute
+          (combine
+             len
+             (go (len `div` 2) offset (stride * 2))
+             (go (len `div` 2) (offset + stride) (stride * 2)))
+      where
+        swivel !(i, j) =
+          case j of
+            0 ->
+              unsafeIndex imgM (i, offset) +
+              unsafeIndex imgM (i, offset + stride)
+            1 ->
+              unsafeIndex imgM (i, offset) -
+              unsafeIndex imgM (i, offset + stride)
+            _ ->
+              error
+                "FFT: Image must have exactly 2 columns. Please, report this bug."
+        {-# INLINE swivel #-}
+    combine !len' !evens !odds =
+      let !odds' =
+            compute $ I.imap (\ !(_, j) !px -> twiddle sign j len' * px) odds
+      in leftToRight (evens + odds') (evens - odds')
+    {-# INLINE combine #-}
+{-# INLINE fftGeneral #-}
 
 
 -- Compute a twiddle factor.
@@ -114,7 +132,8 @@
         -> Int                  -- index
         -> Int                  -- length
         -> Pixel cs (Complex e)
-twiddle sign k n = cos alpha +: sign * sin alpha where
-  !alpha = 2 * pi * fromIntegral k / fromIntegral n
+twiddle !sign !k !n = cos alpha +: sign * sin alpha
+  where
+    !alpha = 2 * pi * fromIntegral k / fromIntegral n
 {-# INLINE twiddle #-}
 
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,49 +1,53 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE BangPatterns          #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
 -- |
 -- Module      : Graphics.Image.Processing.Convolution
--- 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.Processing.Convolution (
-  convolve, convolveRows, convolveCols, correlate
+  -- * Convolution
+  convolve, convolveRows, convolveCols,
+  -- * Correlation
+  correlate
   ) where
 
-import Prelude as P
 
-import Graphics.Image.ColorSpace
-import Graphics.Image.Interface as I
-import Graphics.Image.Processing.Geometric
-
-
+import           Graphics.Image.ColorSpace               (Pixel (..), X)
+import           Graphics.Image.Interface                as I
+import           Graphics.Image.Processing.Geometric
+import           Graphics.Image.Utils                    (loop)
+import           Prelude                                 as P
 
 
 -- | Correlate an image with a kernel. Border resolution technique is required.
-correlate :: Array arr cs e =>
-             Border (Pixel cs e) -> Image arr cs e -> Image arr cs e -> Image arr cs e
+correlate :: (Array arr X e, Array arr cs e)
+          => Border (Pixel cs e) -> Image arr X e -> Image arr cs e -> Image arr cs e
 correlate !border !kernel !img =
-  I.traverse (compute img) (const sz) stencil
+  makeImageWindowed
+    sz
+    (kM2, kN2)
+    (m - kM2 * 2, n - kN2 * 2)
+    (getStencil (I.unsafeIndex imgM))
+    (getStencil (borderIndex border imgM))
   where
-    !kernelM         = toManifest kernel
-    !(krnM, krnN)    = dims kernelM
-    !krnM2           = krnM `div` 2
-    !krnN2           = krnN `div` 2
-    !sz              = dims img
-    getPxB getPx !ix = handleBorderIndex border sz getPx ix
-    {-# INLINE getPxB #-}
-    stencil getImgPx !(i, j) = integrate 0 0 0 where
-      !ikrnM = i - krnM2
-      !jkrnN = j - krnN2
-      integrate !ki !kj !acc
-        | kj == krnN            = integrate (ki+1) 0 acc
-        | kj == 0 && ki == krnM = acc
-        | otherwise             = let !krnPx = I.unsafeIndex kernelM (ki, kj)
-                                      !imgPx = getPxB getImgPx (ki + ikrnM, kj + jkrnN)
-                                  in integrate ki (kj + 1) (acc + krnPx * imgPx)
-    {-# INLINE stencil #-}
+    !imgM = toManifest img
+    !sz@(m, n) = dims img
+    !kernelM = toManifest kernel
+    !(kM, kN) = dims kernel
+    !(kM2, kN2) = (kM `div` 2, kN `div` 2)
+    getStencil getImgPx !(i, j) =
+      loop 0 (< kM) (+ 1) 0 $ \ !iK !acc0 ->
+        let !iD = i + iK - kM2 in
+          loop 0 (< kN) (+ 1) acc0 $ \ !jK !acc1 ->
+            let !jD = j + jK - kN2 in
+              acc1 + liftPx (* getX (unsafeIndex kernelM (iK, jK))) (getImgPx (iD, jD))
+    {-# INLINE getStencil #-}
 {-# INLINE correlate #-}
 
 
@@ -58,25 +62,25 @@
 --
 -- <<images/frogY.jpg>> <<images/frog_sobel.jpg>>
 --
-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 :: (Array arr X e, Array arr cs e) =>
+            Border (Pixel cs e) -- ^ Approach to be used near the borders.
+         -> Image arr X e -- ^ Kernel image.
+         -> Image arr cs e -- ^ Source image.
+         -> Image arr cs e
 convolve !out = correlate out . rotate180
 {-# INLINE convolve #-}
 
 
 -- | Convolve image's rows with a vector kernel represented by a list of pixels.
-convolveRows :: Array arr cs e =>
-                Border (Pixel cs e) -> [Pixel cs e] -> Image arr cs e -> Image arr cs e
+convolveRows :: (Array arr X e, Array arr cs e) =>
+                Border (Pixel cs e) -> [Pixel X e] -> Image arr cs e -> Image arr cs e
 convolveRows !out = convolve out . fromLists . (:[]) . reverse
 {-# INLINE convolveRows #-}
 
 
 -- | Convolve image's columns with a vector kernel represented by a list of pixels.
-convolveCols :: Array arr cs e =>
-                Border (Pixel cs e) -> [Pixel cs e] -> Image arr cs e -> Image arr cs e
+convolveCols :: (Array arr X e, Array arr cs e) =>
+                Border (Pixel cs e) -> [Pixel X e] -> Image arr cs e -> Image arr cs e
 convolveCols !out = convolve out . fromLists . P.map (:[]) . reverse
 {-# INLINE convolveCols #-}
 
diff --git a/src/Graphics/Image/Processing/Filter.hs b/src/Graphics/Image/Processing/Filter.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/Image/Processing/Filter.hs
@@ -0,0 +1,141 @@
+{-# LANGUAGE BangPatterns          #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE TypeSynonymInstances  #-}
+-- |
+-- Module      : Graphics.Image.Processing.Filter
+-- Copyright   : (c) Alexey Kuleshevich 2017
+-- License     : BSD3
+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
+-- Stability   : experimental
+-- Portability : non-portable
+--
+module Graphics.Image.Processing.Filter
+  ( -- * Filter
+    Filter
+  , applyFilter
+  , Direction(..)
+    -- * Gaussian
+  , gaussianLowPass
+  , gaussianBlur
+    -- * Sobel
+  , sobelFilter
+  , sobelOperator
+    -- * Prewitt
+  , prewittFilter
+  , prewittOperator
+  ) where
+
+
+import           Graphics.Image.Interface              as I
+import           Graphics.Image.Processing.Convolution
+import           Graphics.Image.ColorSpace               (X)
+
+
+-- | Filter that can be applied to an image using `applyFilter`.
+--
+-- @since 1.5.3
+data Filter arr cs e = Filter
+  { applyFilter :: Image arr cs e -> Image arr cs e -- ^ Apply a filter to an image
+  }
+
+-- | Used to specify direction for some filters.
+data Direction
+  = Vertical
+  | Horizontal
+
+
+
+-- | Create a Gaussian Filter.
+--
+-- @since 1.5.3
+gaussianLowPass :: (Array arr cs e, Array arr X e, Floating e, Fractional e) =>
+                   Int -- ^ Radius
+                -> e -- ^ Sigma
+                -> Border (Pixel cs e) -- ^ Border resolution technique.
+                -> Filter arr cs e
+gaussianLowPass !r !sigma border =
+  Filter (correlate border gV' . correlate border gV)
+  where
+    !gV = compute $ (gauss / scalar weight)
+    !gV' = compute $ transpose gV
+    !gauss = makeImage (1, n) getPx
+    !weight = I.fold (+) 0 gauss
+    !n = 2 * r + 1
+    !sigma2sq = 2 * sigma ^ (2 :: Int)
+    getPx (_, j) = promote $ exp (fromIntegral (-((j - r) ^ (2 :: Int))) / sigma2sq)
+    {-# INLINE getPx #-}
+{-# INLINE gaussianLowPass #-}
+
+
+
+-- | Create a Gaussian Blur filter. Radius will be derived from standard
+-- deviation: @ceiling (2*sigma)@ and `Edge` border resolution will be
+-- utilized. If custom radius and/or border resolution is desired,
+-- `gaussianLowPass` can be used instead.
+--
+-- @since 1.5.3
+gaussianBlur :: (Array arr cs e, Array arr X e, Floating e, RealFrac e) =>
+                e -- ^ Sigma
+             -> Filter arr cs e
+gaussianBlur !sigma = gaussianLowPass (ceiling (2*sigma)) sigma Edge
+{-# INLINE gaussianBlur #-}
+
+
+sobelFilter :: (Array arr cs e, Array arr X e) =>
+               Direction -> Border (Pixel cs e) -> Filter arr cs e
+sobelFilter dir !border =
+  Filter (correlate border kernel)
+  where
+    !kernel =
+      case dir of
+        Vertical   -> fromLists $ [ [ -1, -2, -1 ]
+                                  , [  0,  0,  0 ]
+                                  , [  1,  2,  1 ] ]
+        Horizontal -> fromLists $ [ [ -1, 0, 1 ]
+                                  , [ -2, 0, 1 ]
+                                  , [ -1, 0, 1 ] ]
+{-# INLINE sobelFilter #-}
+
+-- sobelFilter :: Array arr cs e =>
+--                Direction -> Border (Pixel cs e) -> Filter arr cs e
+-- sobelFilter dir !border =
+--   Filter (convolveCols border cV . convolveRows border rV)
+--   where
+--     !(rV, cV) =
+--       case dir of
+--         Vertical   -> ([1, 2, 1], [1, 0, -1])
+--         Horizontal -> ([1, 0, -1], [1, 2, 1])
+-- {-# INLINE sobelFilter #-}
+
+
+sobelOperator :: (Array arr cs e, Array arr X e, Floating e) => Image arr cs e -> Image arr cs e
+sobelOperator !img = sqrt (sobelX ^ (2 :: Int) + sobelY ^ (2 :: Int))
+  where !sobelX = applyFilter (sobelFilter Horizontal Edge) img
+        !sobelY = applyFilter (sobelFilter Vertical Edge) img
+{-# INLINE sobelOperator #-}
+
+
+
+
+prewittFilter :: (Array arr cs e, Array arr X e) =>
+                 Direction -> Border (Pixel cs e) -> Filter arr cs e
+prewittFilter dir !border =
+  Filter (convolveCols border cV . convolveRows border rV)
+  where
+    !(rV, cV) =
+      case dir of
+        Vertical   -> ([1, 1, 1], [1, 0, -1])
+        Horizontal -> ([1, 0, -1], [1, 1, 1])
+{-# INLINE prewittFilter #-}
+
+
+
+prewittOperator :: (Array arr cs e, Array arr X e, Floating e) => Image arr cs e -> Image arr cs e
+prewittOperator !img = sqrt (prewittX ^ (2 :: Int) + prewittY ^ (2 :: Int))
+  where !prewittX = applyFilter (prewittFilter Horizontal Edge) img
+        !prewittY = applyFilter (prewittFilter Vertical Edge) img
+{-# INLINE prewittOperator #-}
+
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
@@ -1,6 +1,7 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE BangPatterns          #-}
+{-# LANGUAGE CPP                   #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ViewPatterns          #-}
 -- |
 -- Module      : Graphics.Image.Processing.Geometric
 -- Copyright   : (c) Alexey Kuleshevich 2016
@@ -22,16 +23,15 @@
   -- ** Rotation
   rotate90, rotate180, rotate270, rotate,
   -- ** Scaling
-  resize, scale                                          
+  resize, scale
   ) where
 
 #if MIN_VERSION_base(4,8,0)
-import Prelude hiding (traverse)
+import           Prelude                                 hiding (traverse)
 #endif
-
-import Graphics.Image.Interface
-import Graphics.Image.Processing.Interpolation
-import qualified Data.Vector as V
+import qualified Data.Vector                             as V
+import           Graphics.Image.Interface
+import           Graphics.Image.Processing.Interpolation
 
 
 
@@ -41,9 +41,9 @@
 --
 -- >>> frog <- readImageRGB RPU "images/frog.jpg"
 -- >>> displayImage $ downsample ((0 ==) . (`mod` 5)) odd frog
--- 
+--
 -- <<images/frog.jpg>> <<images/frog_downsampled.jpg>>
--- 
+--
 downsample :: Array arr cs e =>
               (Int -> Bool) -- ^ Rows predicate
            -> (Int -> Bool) -- ^ Columns predicate
@@ -71,7 +71,7 @@
 --
 upsample :: Array arr cs e =>
              (Int -> (Int, Int))
-          -> (Int -> (Int, Int))             
+          -> (Int -> (Int, Int))
           -> Image arr cs e
           -> Image arr cs e
 upsample mAdd nAdd !img = traverse img (const (newM, newN)) getNewPx where
@@ -135,7 +135,7 @@
 leftToRight !img1@(dims -> (_, n1)) !img2 = traverse2 img1 img2 newDims newPx where
   newDims !(m1, _) !(m2, n2)
     | m1 == m2  = (m1, n1 + n2)
-    | otherwise = error ("leftToRight: Images must agree in numer of rows, but received: " 
+    | otherwise = error ("leftToRight: Images must agree in numer of rows, but received: "
                          ++ show img1 ++ " and " ++ show img2)
   {-# INLINE newDims #-}
   newPx !getPx1 !getPx2 !(i, j) = if j < n1 then getPx1 (i, j) else getPx2 (i, j-n1)
@@ -165,7 +165,7 @@
 -- >>> writeImage "images/frog_translate_edge.jpg" $ translate Edge (50, 100) frog
 --
 -- <<images/frog.jpg>> <<images/frog_translate_wrap.jpg>> <<images/frog_translate_edge.jpg>>
--- 
+--
 -- @since 1.2.0.0
 --
 translate
@@ -218,7 +218,7 @@
         (Int, Int)     -- ^ @(i, j)@ starting index from within a source image.
      -> (Int, Int)     -- ^ @(m, n)@ dimensions of a new image.
      -> Image arr cs e -- ^ Source image.
-     -> Image arr cs e              
+     -> Image arr cs e
 crop !(i0, j0) !sz@(m', n') !img
   | i0 < 0 || j0 < 0 || i0 >= m || j0 >= n =
     error $
@@ -242,7 +242,7 @@
               (Int, Int)     -- ^ @(i, j)@ starting index from within a source image.
            -> Image arr cs e -- ^ Image to be positioned above the source image.
            -> Image arr cs e -- ^ Source image.
-           -> Image arr cs e              
+           -> Image arr cs e
 superimpose !(i0, j0) !imgA !imgB = traverse2 imgB imgA const newPx where
   !(m, n) = dims imgA
   newPx getPxB getPxA (i, j) = let !(i', j') = (i - i0, j - j0) in
@@ -345,10 +345,13 @@
          (False, False) -> (-mD * cosTheta, nD') -- III quadrant
          (False, True ) -> (0, -mD * sinTheta)   -- IV quadrant
   getNewDims _ = (ceiling mD', ceiling nD')
-  getNewPx getPx (i, j) = interpolate method border sz getPx (i', j') where
-    (iD, jD) = (fromIntegral i - iDelta + 0.5, fromIntegral j - jDelta + 0.5)
-    i' = iD * cosTheta + jD * sinTheta - 0.5
-    j' = jD * cosTheta - iD * sinTheta - 0.5
+  {-# INLINE getNewDims #-}
+  getNewPx getPx !(i, j) = interpolate method border sz getPx (i', j') where
+    !(iD, jD) = (fromIntegral i - iDelta + 0.5, fromIntegral j - jDelta + 0.5)
+    !i' = iD * cosTheta + jD * sinTheta - 0.5
+    !j' = jD * cosTheta - iD * sinTheta - 0.5
+  {-# INLINE getNewPx #-}
+{-# INLINE rotate #-}
 
 
 -- | Resize an image using an interpolation method.
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
@@ -3,7 +3,7 @@
 {-# LANGUAGE ViewPatterns #-}
 -- |
 -- Module      : Graphics.Image.Processing.Interpolation
--- Copyright   : (c) Alexey Kuleshevich 2016
+-- Copyright   : (c) Alexey Kuleshevich 2017
 -- License     : BSD3
 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
 -- Stability   : experimental
@@ -56,8 +56,8 @@
     !jPx = promote $ fromDouble (j - fromIntegral j0)
     !f00 = getPx' (i0, j0)
     !f10 = getPx' (i1, j0)
-    !f01 = getPx' (i0, j1) 
-    !f11 = getPx' (i1, j1) 
+    !f01 = getPx' (i0, j1)
+    !f11 = getPx' (i1, j1)
     !fi0 = f00 + iPx*(f10-f00)
     !fi1 = f01 + iPx*(f11-f01)
   {-# INLINE interpolate #-}
diff --git a/src/Graphics/Image/Utils.hs b/src/Graphics/Image/Utils.hs
new file mode 100644
--- /dev/null
+++ b/src/Graphics/Image/Utils.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE BangPatterns #-}
+-- |
+-- Module      : Graphics.Image.Utils
+-- Copyright   : (c) Alexey Kuleshevich 2017
+-- License     : BSD3
+-- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru>
+-- Stability   : experimental
+-- Portability : non-portable
+--
+module Graphics.Image.Utils
+  ( loop
+  , loopM_
+  , (.:)
+  , (.:!)
+  , swapIx
+  ) where
+
+-- | Boob operator: @((.).(.))@
+(.:) :: (a -> b) -> (c -> d -> a) -> (c -> d -> b)
+(.:) f g = \ x y -> f (g x y)
+{-# INLINE (.:) #-}
+
+
+-- | Strict version of boob operator: @((.).(.))@
+(.:!) :: (a -> b) -> (c -> d -> a) -> (c -> d -> b)
+(.:!) f g = \ !x !y -> let !z = g x y in f z
+{-# INLINE (.:!) #-}
+
+
+-- | Very efficient loop
+loop :: t -> (t -> Bool) -> (t -> t) -> a -> (t -> a -> a) -> a
+loop !init' condition increment !initAcc f = go init' initAcc where
+  go !step !acc =
+    case condition step of
+      False -> acc
+      True  -> go (increment step) (f step acc)
+{-# INLINE loop #-}
+
+-- | Very efficient monadic loop
+loopM_ :: Monad m => t -> (t -> Bool) -> (t -> t) -> (t -> m a) -> m ()
+loopM_ !init' condition increment f = go init' where
+  go !step =
+    case condition step of
+      False -> return ()
+      True  -> f step >> go (increment step)
+{-# INLINE loopM_ #-}
+
+
+swapIx :: (a, b) -> (b, a)
+swapIx !(i, j) = (j, i)
+{-# INLINE swapIx #-}
+
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
@@ -1,36 +1,71 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 module Graphics.Image.ColorSpaceSpec (spec) where
 
-import Test.Hspec
-import Test.QuickCheck
-  
-import Graphics.Image as I
-import Graphics.Image.Interface as II
+import           Graphics.Image           as I
+import           Graphics.Image.Interface as II
+import           Test.Hspec
+import           Test.QuickCheck
 
 
-instance Arbitrary (Pixel Binary Bit) where
+instance Arbitrary (Pixel X Bit) where
   arbitrary = elements [on, off]
 
-instance (ColorSpace Y e, Arbitrary e) => Arbitrary (Pixel Y e) where
-  arbitrary = fromComponents <$> arbitrary
+-- | Generator for values in range @[0, 1]@
+arbitraryDouble :: Gen Double
+arbitraryDouble = toDouble <$> (arbitrary :: Gen Word64)
 
-instance (ColorSpace YA e, Arbitrary e) => Arbitrary (Pixel YA e) where
-  arbitrary = fromComponents <$> arbitrary
 
-instance (ColorSpace RGB e, Arbitrary e) => Arbitrary (Pixel RGB e) where
-  arbitrary = fromComponents <$> arbitrary
+instance Arbitrary (Pixel Y Word8) where
+  arbitrary = PixelY <$> arbitrary
 
-instance (ColorSpace RGBA e, Arbitrary e) => Arbitrary (Pixel RGBA e) where
-  arbitrary = fromComponents <$> arbitrary
+instance Arbitrary (Pixel YA Word8) where
+  arbitrary = PixelYA <$> arbitrary <*> arbitrary
 
+instance Arbitrary (Pixel Y Double) where
+  arbitrary = PixelY <$> arbitraryDouble
 
-prop_ToFromComponents :: ColorSpace cs e =>
-                         Pixel cs e -> Bool
+instance Arbitrary (Pixel YA Double) where
+  arbitrary = PixelYA <$> arbitraryDouble <*> arbitraryDouble
+
+instance Arbitrary (Pixel RGB Word8) where
+  arbitrary = PixelRGB <$> arbitrary <*> arbitrary <*> arbitrary
+
+instance Arbitrary (Pixel RGBA Word8) where
+  arbitrary = PixelRGBA <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
+
+instance Arbitrary (Pixel RGB Double) where
+  arbitrary = PixelRGB <$> arbitraryDouble <*> arbitraryDouble <*> arbitraryDouble
+
+instance Arbitrary (Pixel RGBA Double) where
+  arbitrary =
+    PixelRGBA <$> arbitraryDouble <*> arbitraryDouble <*> arbitraryDouble <*>
+    arbitraryDouble
+
+
+prop_ToFromComponents :: ColorSpace cs e => Pixel cs e -> Bool
 prop_ToFromComponents px = px == fromComponents (toComponents px)
 
 
+prop_ToFromRGB :: ToRGB cs e
+               => (Pixel RGB Double -> Pixel cs e)
+               -> Pixel RGB Double
+               -> Bool
+prop_ToFromRGB fromRGB pxRGB = eqTolPx 1 pxRGB8 pxRGB8' where
+  pxRGB8 = toWord8 <$> pxRGB
+  pxRGB8' = toWord8 <$> toPixelRGB (fromRGB pxRGB)
+
+
 spec :: Spec
-spec = describe "ColorSpace" $ do
-  it "RGBComponents" $ property (prop_ToFromComponents :: Pixel RGB Double -> Bool)
+spec = do
+  describe "ToFromComponents" $ do
+    it "Y Components" $ property (prop_ToFromComponents :: Pixel Y Double -> Bool)
+    it "YA Components" $ property (prop_ToFromComponents :: Pixel YA Double -> Bool)
+    it "RGB Components" $ property (prop_ToFromComponents :: Pixel RGB Double -> Bool)
+    it "RGBA Components" $ property (prop_ToFromComponents :: Pixel RGBA Double -> Bool)
+  describe "YCbCr" $ do
+    it "To From RGB" $ property (prop_ToFromRGB toPixelYCbCr)
+  describe "HSI" $ do
+    it "To From RGB" $ property (prop_ToFromRGB toPixelHSI)
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
@@ -1,12 +1,12 @@
 {-# LANGUAGE FlexibleContexts #-}
 module Graphics.Image.Interface.VectorSpec (spec) where
 
-import Test.Hspec
-import Test.QuickCheck
-
-import Graphics.Image.Interface as I
-
-import Graphics.Image.InterfaceSpec ()
+import           Graphics.Image.ColorSpace
+import           Graphics.Image.Interface        as I
+import           Graphics.Image.Interface.Vector as I
+import           Graphics.Image.InterfaceSpec    ()
+import           Test.Hspec
+import           Test.QuickCheck
 
 prop_fromToIx :: Positive Int -> (NonNegative Int, NonNegative Int) -> Bool
 prop_fromToIx (Positive n) (NonNegative i, NonNegative j) =
@@ -15,8 +15,14 @@
 prop_toFromIx :: Positive Int -> NonNegative Int -> Bool
 prop_toFromIx (Positive n) (NonNegative k) = k == fromIx n (toIx n k)
 
+prop_doubleTranspose :: Image VU Y Word8 -> Bool
+prop_doubleTranspose img = I.transpose (I.transpose img) == img
+
+
 spec :: Spec
 spec = do
   describe "Vector Index Properties" $ do
     it "fromToIx" $ property $ prop_fromToIx
     it "toFromIx" $ property $ prop_toFromIx
+  describe "Interface Properties" $ do
+    it "transpose . transpose" $ property prop_doubleTranspose
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
@@ -21,6 +21,7 @@
 
 import Graphics.Image as I
 import Graphics.Image.Interface as I
+import Graphics.Image.ColorSpaceSpec()
 
 
 data Identical arr1 arr2 cs e =
@@ -28,23 +29,7 @@
        (Image arr2 cs e)
   deriving (Show)
 
--- | Generator for values in range @[0, 1]@
-arbitraryDouble :: Gen Double
-arbitraryDouble = toDouble <$> (arbitrary :: Gen Word64)
 
-
-instance Arbitrary (Pixel Y Word8) where
-  arbitrary = PixelY <$> arbitrary
-
-instance Arbitrary (Pixel Y Double) where
-  arbitrary = PixelY <$> arbitraryDouble
-
-instance Arbitrary (Pixel RGB Word8) where
-  arbitrary = PixelRGB <$> arbitrary <*> arbitrary <*> arbitrary
-
-instance Arbitrary (Pixel RGB Double) where
-  arbitrary = PixelRGB <$> arbitraryDouble <*> arbitraryDouble <*> arbitraryDouble
-
 instance (Array arr cs e, Arbitrary (Pixel cs e)) =>
          Arbitrary (Image arr cs e) where
   arbitrary = do
@@ -84,7 +69,7 @@
       , return Reflect
       , return Continue
       ]
-      
+
 
 #if MIN_VERSION_base(4,8,0)
 instance (Typeable a, Typeable b) => Show (a -> b) where
diff --git a/tests/Graphics/Image/Processing/BinarySpec.hs b/tests/Graphics/Image/Processing/BinarySpec.hs
--- a/tests/Graphics/Image/Processing/BinarySpec.hs
+++ b/tests/Graphics/Image/Processing/BinarySpec.hs
@@ -1,12 +1,12 @@
 {-# LANGUAGE FlexibleContexts #-}
 module Graphics.Image.Processing.BinarySpec (spec, struct) where
 
-import Test.Hspec
+import           Test.Hspec
 
-import Graphics.Image as I
+import           Graphics.Image as I
 
 
-figure :: Image VU Binary Bit
+figure :: Image VU X Bit
 figure =
   fromLists
     [ [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
@@ -29,11 +29,11 @@
     ]
 
 
-struct :: Image VU Binary Bit
+struct :: Image VU X Bit
 struct = fromLists [[0,1,0],[1,1,0],[0,1,0]]
 
 
-eroded :: Image VU Binary Bit
+eroded :: Image VU X Bit
 eroded =
   fromLists
     [ [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
@@ -55,7 +55,7 @@
     , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
     ]
 
-dialated :: Image VU Binary Bit
+dialated :: Image VU X Bit
 dialated =
   fromLists
     [ [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
@@ -78,7 +78,7 @@
     ]
 
 
-opened :: Image VU Binary Bit
+opened :: Image VU X Bit
 opened =
   fromLists
     [ [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
@@ -101,7 +101,7 @@
     ]
 
 
-closed :: Image VU Binary Bit
+closed :: Image VU X Bit
 closed =
   fromLists
     [ [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
@@ -131,4 +131,4 @@
     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)       
+       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
@@ -8,8 +8,8 @@
 import Graphics.Image as I
 
 import Graphics.Image.InterfaceSpec (translateWrap, dummyImage10x20)
-import Graphics.Image.Processing.BinarySpec (struct)
 
+
 data Interpol
   = I1 Nearest
   | I2 Bilinear
@@ -64,7 +64,7 @@
     (m, n) = I.dims img
     (i0, j0) = (iA `mod` m, jA `mod` n)
     (m', n') = (1 + mA `mod` (m - i0), 1 + nA `mod` (n - j0))
-    
+
 prop_concatRotate :: Image VU Y Word8 -> Bool
 prop_concatRotate img =
   topToBottom (rotate90 img) (rotate270 img) ==
@@ -86,6 +86,10 @@
 prop_rotate360 :: Interpol -> Border (Pixel RGB Double) -> Image VU RGB Double -> Bool
 prop_rotate360 (I1 i) border img = (rotate270 . rotate90) img == rotate i border (2*pi) img
 prop_rotate360 (I2 i) border img = (rotate270 . rotate90) img == rotate i border (2*pi) img
+
+
+struct :: Image VS X Bit
+struct = fromLists [[0,1,0],[1,1,0],[0,1,0]]
 
 
 spec :: Spec