hip 1.5.0.0 → 1.5.1.0

raw patch · 33 files changed

+536/−1396 lines, 33 filesdep +repa-algorithmsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: repa-algorithms

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−0
• benchmarks/Canny.hs +25/−87
• hip.cabal +7/−45
• src/Graphics/Image.hs +1/−1
• src/Graphics/Image/ColorSpace.hs +1/−1
• src/Graphics/Image/ColorSpace/Binary.hs +63/−16
• src/Graphics/Image/ColorSpace/CMYK.hs +0/−105
• src/Graphics/Image/ColorSpace/HSI.hs +0/−105
• src/Graphics/Image/ColorSpace/RGB.hs +4/−108
• src/Graphics/Image/ColorSpace/X.hs +1/−59
• src/Graphics/Image/ColorSpace/Y.hs +1/−110
• src/Graphics/Image/ColorSpace/YCbCr.hs +0/−107
• src/Graphics/Image/IO.hs +3/−3
• src/Graphics/Image/IO/Formats/JuicyPixels.hs +2/−2
• src/Graphics/Image/IO/Formats/Netpbm.hs +1/−1
• src/Graphics/Image/Interface.hs +110/−126
• src/Graphics/Image/Interface/Repa.hs +11/−94
• src/Graphics/Image/Interface/Repa/Generic.hs +43/−21
• src/Graphics/Image/Interface/Repa/Storable.hs +32/−65
• src/Graphics/Image/Interface/Repa/Unboxed.hs +21/−53
• src/Graphics/Image/Interface/Vector.hs +27/−12
• src/Graphics/Image/Interface/Vector/Generic.hs +44/−56
• src/Graphics/Image/Interface/Vector/Storable.hs +13/−37
• src/Graphics/Image/Interface/Vector/Unboxed.hs +14/−36
• src/Graphics/Image/Interface/Vector/Unboxing.hs +8/−65
• src/Graphics/Image/Processing/Binary.hs +2/−2
• src/Graphics/Image/Processing/Complex/Fourier.hs +5/−6
• src/Graphics/Image/Processing/Convolution.hs +19/−40
• src/Graphics/Image/Processing/Interpolation.hs +1/−1
• src/Graphics/Image/Types.hs +5/−4
• tests/Graphics/Image/Interface/RepaSpec.hs +25/−0
• tests/Graphics/Image/Interface/VectorSpec.hs +2/−8
• tests/Graphics/Image/InterfaceSpec.hs +35/−20

@@ -1,3 +1,13 @@+1.5.1.0+=======++* Significantly improved convolution performance.+* Improved exchanging representation between images, by removing `Exchangable`+  class, but keeping `exchange` function usage unchaged, thus it should be+  backwards compatible up to a type signature.+* Created general `fromVector` to `toVector` functions+* Brought back `fromRepaArrayS` and `fromRepaArrayP` functions [#6]+ 1.5.0.0 ======= 

@@ -8,13 +8,13 @@ import Graphics.Image.Interface as I import Graphics.Image.Interface.Repa - import Data.Array.Repa as R-import Data.Array.Repa.Eval-import Data.Array.Repa.Repr.Unboxed-import Data.Array.Repa.Stencil-import Data.Array.Repa.Stencil.Dim2-+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 =@@ -24,28 +24,19 @@ sobelGy =   convolve Edge (fromLists [[-1,-2,-1], [ 0, 0, 0], [ 1, 2, 1]]) --- sobelSGx :: (Exchangable arr VS, I.Array arr cs e, I.Array VS cs e) => Image arr cs e -> Image arr cs e--- sobelSGx =---   convolveSparse Edge (fromLists [[-1, 0, 1], [-2, 0, 2], [-1, 0, 1]])---- sobelSGy :: (Exchangable arr VS, I.Array arr cs e, I.Array VS cs e) => Image arr cs e -> Image arr cs e--- sobelSGy =---   convolveSparse Edge (fromLists [[-1,-2,-1], [ 0, 0, 0], [ 1, 2, 1]])----- sobelSGx' :: (Exchangable arr VS, I.Array arr cs e, I.Array VS cs e) => Image arr cs e -> Image arr cs e--- sobelSGx' =---   convolveSparse Edge (fromLists [[1], [2], [1]]) . convolveSparse Edge (fromLists [[1, 0, -1]])--sobelGx' :: I.Array arr cs e => Image arr cs e -> Image arr cs e-sobelGx' =+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] -sobelGy' :: I.Array arr cs e => Image arr cs e -> Image arr cs e-sobelGy' =+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@@ -85,77 +76,24 @@  main :: IO () main = do-  img' <- readImageRGB RPU "images/downloaded/frog-1280x824.jpg"-  let !imgU = compute img'-  --let !imgS = exchange RPS imgU+  -- img' <- readImageRGB RPU "images/frog.jpg"+  -- let !imgU = compute img'+  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 = sobelGx' imgU-  -- let sobelS = sobelGx imgS-  -- let sobelSepS = sobelGx' imgS-  -- let sobelSepVS = sobelSGx' img-  -- let sobelVS = sobelSGx img-  -- let sobelMS = sobelMSGx img-  -- let sobelIMS = sobelIMSGx img-  -- let sobelHMS = sobelHMSGx img+  let sobelSepU = sobelGxSep imgU   let !imgR = toRepaArray imgU-  --imgRDouble <- force $ R.map (`getPxCh` Y) imgR   let sobelR = sobelGxR imgR-  --let sobelRDouble = sobelGxR imgRDouble+  let sobelRAlg = sobelGxRAlg imgR   defaultMain     [ bgroup         "Sobel"-        [ bench "naive U" $ whnf compute sobelU+        [+          bench "naive U" $ whnf compute sobelU         , bench "separated U" $ whnf compute sobelSepU-        -- , bench "naive S" $ whnf compute sobelS-        -- , bench "separated S" $ whnf compute sobelSepS-        -- , bench "separated VS" $ whnf compute sobelSepVS-        -- , bench "sparse VS" $ whnf compute sobelVS-        -- , bench "sparse MS" $ whnf compute sobelMS-        -- , bench "sparse IMS" $ whnf compute sobelIMS-        -- , bench "sparse HMS" $ whnf compute sobelHMS-        --, bench "repa" $ whnf (compute . fromRepaArrayP) sobelR-        , bench "repa RGB" $ whnfIO (force sobelR)-        --, bench "repa Double" $ whnfIO (force sobelRDouble)+        , bench "repa U Agorithms" $ whnfIO sobelRAlg+        , bench "repa U Stencil" $ whnfIO (force sobelR)         ]     ]-  -- img' <- readImageY RS "images/downloaded/frog-1280x824.jpg"-  -- let !imgR = compute img'-  -- let !imgV = toManifest imgR-  -- -- let sobel = sobelGx imgV-  -- -- let sobel' = sobelGx' imgV-  -- -- let sobel'' = sobelSGx imgV-  -- let arrR = toRepaArray imgR-  -- let sobelR = sobelGxR arrR-  -- defaultMain-  --   [ bgroup-  --       "Sobel"-  --       [ bench "naive" $ nf sobelGx imgV-  --       , bench "separated" $ nf sobelGx' imgV-  --       , bench "sparse" $ nf sobelSGx imgV-  --       --, bench "repa" $ whnf (compute . fromRepaArrayP) sobelR-  --       , bench "repa" $ whnfIO (force sobelR)-  --       ]-  --   ]--  -- let sobel = sqrt (sobelGx img ^ (2 :: Int) + sobelGy img ^ (2 :: Int))-  -- let sobel' = sqrt (sobelGx' img ^ (2 :: Int) + sobelGy' img ^ (2 :: Int))-  -- let sobel'' = sqrt (sobelSGx img ^ (2 :: Int) + sobelSGy img ^ (2 :: Int))-  -- let sobel''' = sqrt (sobelMSGx img ^ (2 :: Int) + sobelMSGy img ^ (2 :: Int))-  -- let imgR = toRepaArray img-  -- let sobelR =-  --       R.map-  --         sqrt-  --         (R.map (^ (2 :: Int)) (sobelGxR imgR) +^-  --          R.map (^ (2 :: Int)) (sobelGyR imgR))-  -- defaultMain-  --   [ bgroup-  --       "Sobel"-  --       [ bench "naive" $ whnf compute sobel-  --       , bench "separated" $ whnf compute sobel'-  --       , bench "sparse VS" $ whnf compute sobel''-  --       , bench "sparse MS" $ whnf compute sobel'''-  --       --, bench "repa" $ whnf (compute . fromRepaArrayP) sobelR-  --       , bench "repa" $ whnfIO (force sobelR)-  --       ]-  --   ] 

@@ -1,5 +1,5 @@ Name:              hip-Version:           1.5.0.0+Version:           1.5.1.0 License:           BSD3 License-File:      LICENSE Author:            Alexey Kuleshevich@@ -27,15 +27,15 @@   Default-Language: Haskell2010   HS-Source-Dirs: src -  Build-Depends: base            >= 4.5 && < 5-               , bytestring      >= 0.9.0.4-               , Chart           >= 1.5+  Build-Depends: Chart           >= 1.5                , Chart-diagrams  >= 1.5+               , JuicyPixels     >= 3.2.7+               , base            >= 4.5 && < 5+               , bytestring      >= 0.9.0.4                , colour          >= 2.3.3                , deepseq         >= 1.1                , directory       >= 1.2.2.0                , filepath        >= 1.0-               , JuicyPixels     >= 3.2.7                , netpbm          >= 1.0.1                , primitive       >= 0.4                , process         >= 1.1.0.0@@ -107,6 +107,7 @@                     , Graphics.Image.Processing.BinarySpec                     , Graphics.Image.InterfaceSpec                     , Graphics.Image.Interface.VectorSpec+                    , Graphics.Image.Interface.RepaSpec                     , Graphics.Image.IO.FormatsSpec   Build-Depends:      base            >= 4.5 && < 5                     , bytestring@@ -117,55 +118,16 @@   GHC-Options:        -Wall -threaded -with-rtsopts=-N  --- benchmark pixels-benchmarks---   type:                exitcode-stdio-1.0---   hs-source-dirs:      benchmarks---   main-is:             Pixels.hs---   ghc-options:         -threaded -rtsopts -with-rtsopts=-N -O2---   build-depends:       base---                      , criterion---                      , deepseq---                      , hip---                      , vector---   default-language:    Haskell2010---- benchmark pixels-memory---   type:                exitcode-stdio-1.0---   hs-source-dirs:      benchmarks/memory---   main-is:             Pixels.hs---   ghc-options:         -O2---                        -- -threaded -rtsopts -with-rtsopts=-N---   build-depends:       base---                      , criterion---                      , deepseq---                      , hip---                      , weigh---                      , vector---                      , repa---   default-language:    Haskell2010---- benchmark interface-benchmarks---   type:                exitcode-stdio-1.0---   hs-source-dirs:      benchmarks---   main-is:             Interface.hs---   ghc-options:         -threaded -rtsopts -with-rtsopts=-N -O2---   build-depends:       base---                      , criterion---                      , deepseq---                      , hip---                      , vector---   default-language:    Haskell2010- benchmark convolution-benchmarks   type:                exitcode-stdio-1.0   hs-source-dirs:      benchmarks   main-is:             Canny.hs   ghc-options:         -threaded -rtsopts -with-rtsopts=-N -O2-  --ghc-options:         -Odph -rtsopts -with-rtsopts=-N -threaded -fno-liberate-case -funfolding-use-threshold1000 -funfolding-keeness-factor1000 -fllvm -optlo-O3   build-depends:       base                      , criterion                      , deepseq                      , repa+                     , repa-algorithms                      , hip   default-language:    Haskell2010 

@@ -237,7 +237,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, Num e) =>+  :: (Array arr Binary 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 #-}

@@ -90,7 +90,7 @@  -- | Check weather two Pixels are equal within a tolerance. Useful for comparing -- pixels with `Float` or `Double` precision.-eqTolPx :: (ColorSpace cs e, Num e, Ord e) =>+eqTolPx :: (ColorSpace cs e, Ord e) =>            e -> Pixel cs e -> Pixel cs e -> Bool eqTolPx !tol = foldlPx2 comp True    where comp !acc !e1 !e2 = acc && max e1 e2 - min e1 e2 <= tol

@@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}@@ -19,13 +20,18 @@   ) where  import Prelude hiding (map)+import Control.Monad import Data.Bits import Data.Word (Word8) import Graphics.Image.Interface 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 + -- | This is a Binary colorspace, pixel's of which can be created using -- these __/constructors/__: --@@ -55,7 +61,7 @@ -- values of @0@ or @1@. newtype Bit = Bit Word8 deriving (Ord, Eq, Typeable) -data instance Pixel Binary Bit = PixelBinary {-# UNPACK #-} !Bit deriving (Ord, Eq)+newtype instance Pixel Binary Bit = PixelBinary Bit deriving (Ord, Eq)  instance Show (Pixel Binary Bit) where   show (PixelBinary (Bit 0)) = "<Binary:(0)>"@@ -247,21 +253,6 @@   {-# INLINE fromInteger #-}  -instance Num (Pixel Binary Bit) where-  (+)         = liftPx2 (+)-  {-# INLINE (+) #-}-  (-)         = liftPx2 (-)-  {-# INLINE (-) #-}-  (*)         = liftPx2 (*)-  {-# INLINE (*) #-}-  abs         = liftPx abs-  {-# INLINE abs #-}-  signum      = liftPx signum-  {-# INLINE signum #-}-  fromInteger = promote . fromInteger-  {-# INLINE fromInteger #-}-- instance Storable Bit where    sizeOf _ = sizeOf (undefined :: Word8)@@ -286,3 +277,59 @@   poke p (PixelBinary b) = do     q <- return $ castPtr p     poke q b++++-- | Unboxing of a `Bit`.+instance U.Unbox Bit++newtype instance U.MVector s Bit = MV_Bit (U.MVector s Word8)++instance M.MVector U.MVector Bit where+  basicLength (MV_Bit mvec) = M.basicLength mvec+  {-# INLINE basicLength #-}+  basicUnsafeSlice idx len (MV_Bit mvec) = MV_Bit (M.basicUnsafeSlice idx len mvec)+  {-# INLINE basicUnsafeSlice #-}+  basicOverlaps (MV_Bit mvec) (MV_Bit mvec') = M.basicOverlaps mvec mvec'+  {-# INLINE basicOverlaps #-}+  basicUnsafeNew len = MV_Bit `liftM` M.basicUnsafeNew len+  {-# INLINE basicUnsafeNew #-}+  basicUnsafeReplicate len (Bit w) = MV_Bit `liftM` M.basicUnsafeReplicate len w+  {-# INLINE basicUnsafeReplicate #-}+  basicUnsafeRead (MV_Bit mvec) idx = Bit `liftM` M.basicUnsafeRead mvec idx+  {-# INLINE basicUnsafeRead #-}+  basicUnsafeWrite (MV_Bit mvec) idx (Bit w) = M.basicUnsafeWrite mvec idx w+  {-# INLINE basicUnsafeWrite #-}+  basicClear (MV_Bit mvec) = M.basicClear mvec+  {-# INLINE basicClear #-}+  basicSet (MV_Bit mvec) (Bit w) =  M.basicSet mvec w+  {-# INLINE basicSet #-}+  basicUnsafeCopy (MV_Bit mvec) (MV_Bit mvec') = M.basicUnsafeCopy mvec mvec'+  {-# INLINE basicUnsafeCopy #-}+  basicUnsafeMove (MV_Bit mvec) (MV_Bit mvec') = M.basicUnsafeMove mvec mvec'+  {-# INLINE basicUnsafeMove #-}+  basicUnsafeGrow (MV_Bit mvec) len = MV_Bit `liftM` M.basicUnsafeGrow mvec len+  {-# INLINE basicUnsafeGrow #-}+#if MIN_VERSION_vector(0,11,0)+  basicInitialize (MV_Bit mvec) = M.basicInitialize mvec+  {-# INLINE basicInitialize #-}+#endif+++newtype instance U.Vector Bit = V_Bit (U.Vector Word8)++instance V.Vector U.Vector Bit where+  basicUnsafeFreeze (MV_Bit mvec) = V_Bit `liftM` V.basicUnsafeFreeze mvec+  {-# INLINE basicUnsafeFreeze #-}+  basicUnsafeThaw (V_Bit vec) = MV_Bit `liftM` V.basicUnsafeThaw vec+  {-# INLINE basicUnsafeThaw #-}+  basicLength (V_Bit vec) = V.basicLength vec+  {-# INLINE basicLength #-}+  basicUnsafeSlice idx len (V_Bit vec) = V_Bit (V.basicUnsafeSlice idx len vec)+  {-# INLINE basicUnsafeSlice #-}+  basicUnsafeIndexM (V_Bit vec) idx = Bit `liftM` V.basicUnsafeIndexM vec idx+  {-# INLINE basicUnsafeIndexM #-}+  basicUnsafeCopy (MV_Bit mvec) (V_Bit vec) = V.basicUnsafeCopy mvec vec+  {-# INLINE basicUnsafeCopy #-}+  elemseq (V_Bit vec) (Bit w) = V.elemseq vec w+  {-# INLINE elemseq #-}

@@ -95,59 +95,7 @@   {-# INLINE foldr #-}  -instance Num e => Num (Pixel CMYK e) where-  (+)         = liftA2 (+)-  {-# INLINE (+) #-}-  (-)         = liftA2 (-)-  {-# INLINE (-) #-}-  (*)         = liftA2 (*)-  {-# INLINE (*) #-}-  abs         = liftA abs-  {-# INLINE abs #-}-  signum      = liftA signum-  {-# INLINE signum #-}-  fromInteger = pure . fromInteger-  {-# INLINE fromInteger #-} --instance Fractional e => Fractional (Pixel CMYK e) where-  (/)          = liftA2 (/)-  {-# INLINE (/) #-}-  recip        = liftA recip-  {-# INLINE recip #-}-  fromRational = pure . fromRational-  {-# INLINE fromRational #-}---instance Floating e => Floating (Pixel CMYK e) where-  pi      = pure pi-  {-# INLINE pi #-}-  exp     = liftA exp-  {-# INLINE exp #-}-  log     = liftA log-  {-# INLINE log #-}-  sin     = liftA sin-  {-# INLINE sin #-}-  cos     = liftA cos-  {-# INLINE cos #-}-  asin    = liftA asin-  {-# INLINE asin #-}-  atan    = liftA atan-  {-# INLINE atan #-}-  acos    = liftA acos-  {-# INLINE acos #-}-  sinh    = liftA sinh-  {-# INLINE sinh #-}-  cosh    = liftA cosh-  {-# INLINE cosh #-}-  asinh   = liftA asinh-  {-# INLINE asinh #-}-  atanh   = liftA atanh-  {-# INLINE atanh #-}-  acosh   = liftA acosh-  {-# INLINE acosh #-}-- instance Storable e => Storable (Pixel CMYK e) where    sizeOf _ = 3 * sizeOf (undefined :: e)@@ -281,59 +229,6 @@ instance Foldable (Pixel CMYKA) where   foldr f !z (PixelCMYKA c m y k a) = f c (f m (f y (f k (f a z))))   {-# INLINE foldr #-}---instance Num e => Num (Pixel CMYKA e) where-  (+)         = liftA2 (+)-  {-# INLINE (+) #-}-  (-)         = liftA2 (-)-  {-# INLINE (-) #-}-  (*)         = liftA2 (*)-  {-# INLINE (*) #-}-  abs         = liftA abs-  {-# INLINE abs #-}-  signum      = liftA signum-  {-# INLINE signum #-}-  fromInteger = pure . fromInteger-  {-# INLINE fromInteger #-}---instance Fractional e => Fractional (Pixel CMYKA e) where-  (/)          = liftA2 (/)-  {-# INLINE (/) #-}-  recip        = liftA recip-  {-# INLINE recip #-}-  fromRational = pure . fromRational-  {-# INLINE fromRational #-}---instance Floating e => Floating (Pixel CMYKA e) where-  pi      = pure pi-  {-# INLINE pi #-}-  exp     = liftA exp-  {-# INLINE exp #-}-  log     = liftA log-  {-# INLINE log #-}-  sin     = liftA sin-  {-# INLINE sin #-}-  cos     = liftA cos-  {-# INLINE cos #-}-  asin    = liftA asin-  {-# INLINE asin #-}-  atan    = liftA atan-  {-# INLINE atan #-}-  acos    = liftA acos-  {-# INLINE acos #-}-  sinh    = liftA sinh-  {-# INLINE sinh #-}-  cosh    = liftA cosh-  {-# INLINE cosh #-}-  asinh   = liftA asinh-  {-# INLINE asinh #-}-  atanh   = liftA atanh-  {-# INLINE atanh #-}-  acosh   = liftA acosh-  {-# INLINE acosh #-}   instance Storable e => Storable (Pixel CMYKA e) where

@@ -90,59 +90,7 @@   foldr f !z (PixelHSI h s i) = f h (f s (f i z))   {-# INLINE foldr #-} -instance Num e => Num (Pixel HSI e) where-  (+)         = liftA2 (+)-  {-# INLINE (+) #-}-  (-)         = liftA2 (-)-  {-# INLINE (-) #-}-  (*)         = liftA2 (*)-  {-# INLINE (*) #-}-  abs         = liftA abs-  {-# INLINE abs #-}-  signum      = liftA signum-  {-# INLINE signum #-}-  fromInteger = pure . fromInteger-  {-# INLINE fromInteger #-}-   -instance Fractional e => Fractional (Pixel HSI e) where-  (/)          = liftA2 (/)-  {-# INLINE (/) #-}-  recip        = liftA recip-  {-# INLINE recip #-}-  fromRational = pure . fromRational-  {-# INLINE fromRational #-}---instance Floating e => Floating (Pixel HSI e) where-  pi      = pure pi-  {-# INLINE pi #-}-  exp     = liftA exp-  {-# INLINE exp #-}-  log     = liftA log-  {-# INLINE log #-}-  sin     = liftA sin-  {-# INLINE sin #-}-  cos     = liftA cos-  {-# INLINE cos #-}-  asin    = liftA asin-  {-# INLINE asin #-}-  atan    = liftA atan-  {-# INLINE atan #-}-  acos    = liftA acos-  {-# INLINE acos #-}-  sinh    = liftA sinh-  {-# INLINE sinh #-}-  cosh    = liftA cosh-  {-# INLINE cosh #-}-  asinh   = liftA asinh-  {-# INLINE asinh #-}-  atanh   = liftA atanh-  {-# INLINE atanh #-}-  acosh   = liftA acosh-  {-# INLINE acosh #-}-- instance Storable e => Storable (Pixel HSI e) where    sizeOf _ = 3 * sizeOf (undefined :: e)@@ -268,59 +216,6 @@ instance Foldable (Pixel HSIA) where   foldr f !z (PixelHSIA h s i a) = f h (f s (f i (f a z)))   {-# INLINE foldr #-}---instance Num e => Num (Pixel HSIA e) where-  (+)         = liftA2 (+)-  {-# INLINE (+) #-}-  (-)         = liftA2 (-)-  {-# INLINE (-) #-}-  (*)         = liftA2 (*)-  {-# INLINE (*) #-}-  abs         = liftA abs-  {-# INLINE abs #-}-  signum      = liftA signum-  {-# INLINE signum #-}-  fromInteger = pure . fromInteger-  {-# INLINE fromInteger #-}---instance Fractional e => Fractional (Pixel HSIA e) where-  (/)          = liftA2 (/)-  {-# INLINE (/) #-}-  recip        = liftA recip-  {-# INLINE recip #-}-  fromRational = pure . fromRational-  {-# INLINE fromRational #-}---instance Floating e => Floating (Pixel HSIA e) where-  pi      = pure pi-  {-# INLINE pi #-}-  exp     = liftA exp-  {-# INLINE exp #-}-  log     = liftA log-  {-# INLINE log #-}-  sin     = liftA sin-  {-# INLINE sin #-}-  cos     = liftA cos-  {-# INLINE cos #-}-  asin    = liftA asin-  {-# INLINE asin #-}-  atan    = liftA atan-  {-# INLINE atan #-}-  acos    = liftA acos-  {-# INLINE acos #-}-  sinh    = liftA sinh-  {-# INLINE sinh #-}-  cosh    = liftA cosh-  {-# INLINE cosh #-}-  asinh   = liftA asinh-  {-# INLINE asinh #-}-  atanh   = liftA atanh-  {-# INLINE atanh #-}-  acosh   = liftA acosh-  {-# INLINE acosh #-}   instance Storable e => Storable (Pixel HSIA e) where

@@ -107,71 +107,20 @@   {-# INLINE foldr #-}  -instance Num e => Num (Pixel RGB e) where-  (+)         = liftA2 (+)-  {-# INLINE (+) #-}-  (-)         = liftA2 (-)-  {-# INLINE (-) #-}-  (*)         = liftA2 (*)-  {-# INLINE (*) #-}-  abs         = liftA abs-  {-# INLINE abs #-}-  signum      = liftA signum-  {-# INLINE signum #-}-  fromInteger = pure . fromInteger-  {-# INLINE fromInteger #-}-   -instance Fractional e => Fractional (Pixel RGB e) where-  (/)          = liftA2 (/)-  {-# INLINE (/) #-}-  recip        = liftA recip-  {-# INLINE recip #-}-  fromRational = pure . fromRational-  {-# INLINE fromRational #-} --instance Floating e => Floating (Pixel RGB e) where-  pi      = pure pi-  {-# INLINE pi #-}-  exp     = liftA exp-  {-# INLINE exp #-}-  log     = liftA log-  {-# INLINE log #-}-  sin     = liftA sin-  {-# INLINE sin #-}-  cos     = liftA cos-  {-# INLINE cos #-}-  asin    = liftA asin-  {-# INLINE asin #-}-  atan    = liftA atan-  {-# INLINE atan #-}-  acos    = liftA acos-  {-# INLINE acos #-}-  sinh    = liftA sinh-  {-# INLINE sinh #-}-  cosh    = liftA cosh-  {-# INLINE cosh #-}-  asinh   = liftA asinh-  {-# INLINE asinh #-}-  atanh   = liftA atanh-  {-# INLINE atanh #-}-  acosh   = liftA acosh-  {-# INLINE acosh #-}-- instance Storable e => Storable (Pixel RGB e) where    sizeOf _ = 3 * sizeOf (undefined :: e)   alignment _ = alignment (undefined :: e)-  peek p = do-    q <- return $ castPtr p+  peek !p = do+    let !q = castPtr p     r <- peek q     g <- peekElemOff q 1     b <- peekElemOff q 2     return (PixelRGB r g b)-  poke p (PixelRGB r g b) = do-    q <- return $ castPtr p+  poke !p (PixelRGB r g b) = do+    let !q = castPtr p     poke q r     pokeElemOff q 1 g     pokeElemOff q 2 b@@ -272,59 +221,6 @@   foldr f !z (PixelRGBA r g b a) = f r (f g (f b (f a z)))   {-# INLINE foldr #-} ---instance Num e => Num (Pixel RGBA e) where-  (+)         = liftA2 (+)-  {-# INLINE (+) #-}-  (-)         = liftA2 (-)-  {-# INLINE (-) #-}-  (*)         = liftA2 (*)-  {-# INLINE (*) #-}-  abs         = liftA abs-  {-# INLINE abs #-}-  signum      = liftA signum-  {-# INLINE signum #-}-  fromInteger = pure . fromInteger-  {-# INLINE fromInteger #-}---instance Fractional e => Fractional (Pixel RGBA e) where-  (/)          = liftA2 (/)-  {-# INLINE (/) #-}-  recip        = liftA recip-  {-# INLINE recip #-}-  fromRational = pure . fromRational-  {-# INLINE fromRational #-}---instance Floating e => Floating (Pixel RGBA e) where-  pi      = pure pi-  {-# INLINE pi #-}-  exp     = liftA exp-  {-# INLINE exp #-}-  log     = liftA log-  {-# INLINE log #-}-  sin     = liftA sin-  {-# INLINE sin #-}-  cos     = liftA cos-  {-# INLINE cos #-}-  asin    = liftA asin-  {-# INLINE asin #-}-  atan    = liftA atan-  {-# INLINE atan #-}-  acos    = liftA acos-  {-# INLINE acos #-}-  sinh    = liftA sinh-  {-# INLINE sinh #-}-  cosh    = liftA cosh-  {-# INLINE cosh #-}-  asinh   = liftA asinh-  {-# INLINE asinh #-}-  atanh   = liftA atanh-  {-# INLINE atanh #-}-  acosh   = liftA acosh-  {-# INLINE acosh #-}    instance Storable e => Storable (Pixel RGBA e) where

@@ -34,7 +34,7 @@ data X = X deriving (Eq, Enum, Bounded, Show, Typeable)  -data instance Pixel X e = PixelX !e deriving (Ord, Eq)+newtype instance Pixel X e = PixelX e deriving (Ord, Eq)   instance Show e => Show (Pixel X e) where@@ -90,64 +90,6 @@    (>>=) (PixelX g) f = f g   {-# INLINE (>>=) #-}---instance Num e => Num (Pixel X e) where-  (+)         = liftA2 (+)-  {-# INLINE (+) #-}-  -  (-)         = liftA2 (-)-  {-# INLINE (-) #-}-  -  (*)         = liftA2 (*)-  {-# INLINE (*) #-}-  -  abs         = liftA abs-  {-# INLINE abs #-}-  -  signum      = liftA signum-  {-# INLINE signum #-}-  -  fromInteger = pure . fromInteger-  {-# INLINE fromInteger #-}---instance Fractional e => Fractional (Pixel X e) where-  (/)          = liftA2 (/)-  {-# INLINE (/) #-}-  recip        = liftA recip-  {-# INLINE recip #-}-  fromRational = pure . fromRational-  {-# INLINE fromRational #-}---instance Floating e => Floating (Pixel X e) where-  pi      = pure pi-  {-# INLINE pi #-}-  exp     = liftA exp-  {-# INLINE exp #-}-  log     = liftA log-  {-# INLINE log #-}-  sin     = liftA sin-  {-# INLINE sin #-}-  cos     = liftA cos-  {-# INLINE cos #-}-  asin    = liftA asin-  {-# INLINE asin #-}-  atan    = liftA atan-  {-# INLINE atan #-}-  acos    = liftA acos-  {-# INLINE acos #-}-  sinh    = liftA sinh-  {-# INLINE sinh #-}-  cosh    = liftA cosh-  {-# INLINE cosh #-}-  asinh   = liftA asinh-  {-# INLINE asinh #-}-  atanh   = liftA atanh-  {-# INLINE atanh #-}-  acosh   = liftA acosh-  {-# INLINE acosh #-}   instance Storable e => Storable (Pixel X e) where

@@ -35,7 +35,7 @@ data Y = LumaY deriving (Eq, Enum, Show, Bounded, Typeable)  -data instance Pixel Y e = PixelY !e deriving (Ord, Eq)+newtype instance Pixel Y e = PixelY e deriving (Ord, Eq)  -- | Conversion to Luma color space. class ColorSpace cs Double => ToY cs where@@ -103,59 +103,7 @@   {-# INLINE (>>=) #-}  -instance Num e => Num (Pixel Y e) where-  (+)         = liftA2 (+)-  {-# INLINE (+) #-}-  (-)         = liftA2 (-)-  {-# INLINE (-) #-}-  (*)         = liftA2 (*)-  {-# INLINE (*) #-}-  abs         = liftA abs-  {-# INLINE abs #-}-  signum      = liftA signum-  {-# INLINE signum #-}-  fromInteger = pure . fromInteger-  {-# INLINE fromInteger #-}-   -instance Fractional e => Fractional (Pixel Y e) where-  (/)          = liftA2 (/)-  {-# INLINE (/) #-}-  recip        = liftA recip-  {-# INLINE recip #-}-  fromRational = pure . fromRational-  {-# INLINE fromRational #-}---instance Floating e => Floating (Pixel Y e) where-  pi      = pure pi-  {-# INLINE pi #-}-  exp     = liftA exp-  {-# INLINE exp #-}-  log     = liftA log-  {-# INLINE log #-}-  sin     = liftA sin-  {-# INLINE sin #-}-  cos     = liftA cos-  {-# INLINE cos #-}-  asin    = liftA asin-  {-# INLINE asin #-}-  atan    = liftA atan-  {-# INLINE atan #-}-  acos    = liftA acos-  {-# INLINE acos #-}-  sinh    = liftA sinh-  {-# INLINE sinh #-}-  cosh    = liftA cosh-  {-# INLINE cosh #-}-  asinh   = liftA asinh-  {-# INLINE asinh #-}-  atanh   = liftA atanh-  {-# INLINE atanh #-}-  acosh   = liftA acosh-  {-# INLINE acosh #-}-- instance Storable e => Storable (Pixel Y e) where    sizeOf _ = sizeOf (undefined :: e)@@ -250,63 +198,6 @@ instance Foldable (Pixel YA) where   foldr f !z (PixelYA y a) = f y (f a z)   {-# INLINE foldr #-}---instance Num e => Num (Pixel YA e) where-  (+)         = liftA2 (+)-  {-# INLINE (+) #-}-  -  (-)         = liftA2 (-)-  {-# INLINE (-) #-}-  -  (*)         = liftA2 (*)-  {-# INLINE (*) #-}-  -  abs         = liftA abs-  {-# INLINE abs #-}-  -  signum      = liftA signum-  {-# INLINE signum #-}-  -  fromInteger = pure . fromInteger-  {-# INLINE fromInteger #-}--instance Fractional e => Fractional (Pixel YA e) where-  (/)          = liftA2 (/)-  {-# INLINE (/) #-}-  recip        = liftA recip-  {-# INLINE recip #-}-  fromRational = pure . fromRational-  {-# INLINE fromRational #-}---instance Floating e => Floating (Pixel YA e) where-  pi      = pure pi-  {-# INLINE pi #-}-  exp     = liftA exp-  {-# INLINE exp #-}-  log     = liftA log-  {-# INLINE log #-}-  sin     = liftA sin-  {-# INLINE sin #-}-  cos     = liftA cos-  {-# INLINE cos #-}-  asin    = liftA asin-  {-# INLINE asin #-}-  atan    = liftA atan-  {-# INLINE atan #-}-  acos    = liftA acos-  {-# INLINE acos #-}-  sinh    = liftA sinh-  {-# INLINE sinh #-}-  cosh    = liftA cosh-  {-# INLINE cosh #-}-  asinh   = liftA asinh-  {-# INLINE asinh #-}-  atanh   = liftA atanh-  {-# INLINE atanh #-}-  acosh   = liftA acosh-  {-# INLINE acosh #-}   instance Storable e => Storable (Pixel YA e) where

@@ -93,60 +93,6 @@   {-# INLINE foldr #-}  -instance Num e => Num (Pixel YCbCr e) where-  (+)         = liftA2 (+)-  {-# INLINE (+) #-}-  (-)         = liftA2 (-)-  {-# INLINE (-) #-}-  (*)         = liftA2 (*)-  {-# INLINE (*) #-}-  abs         = liftA abs-  {-# INLINE abs #-}-  signum      = liftA signum-  {-# INLINE signum #-}-  fromInteger = pure . fromInteger-  {-# INLINE fromInteger #-}---instance Fractional e => Fractional (Pixel YCbCr e) where-  (/)          = liftA2 (/)-  {-# INLINE (/) #-}-  recip        = liftA recip-  {-# INLINE recip #-}-  fromRational = pure . fromRational-  {-# INLINE fromRational #-}---instance Floating e => Floating (Pixel YCbCr e) where-  pi      = pure pi-  {-# INLINE pi #-}-  exp     = liftA exp-  {-# INLINE exp #-}-  log     = liftA log-  {-# INLINE log #-}-  sin     = liftA sin-  {-# INLINE sin #-}-  cos     = liftA cos-  {-# INLINE cos #-}-  asin    = liftA asin-  {-# INLINE asin #-}-  atan    = liftA atan-  {-# INLINE atan #-}-  acos    = liftA acos-  {-# INLINE acos #-}-  sinh    = liftA sinh-  {-# INLINE sinh #-}-  cosh    = liftA cosh-  {-# INLINE cosh #-}-  asinh   = liftA asinh-  {-# INLINE asinh #-}-  atanh   = liftA atanh-  {-# INLINE atanh #-}-  acosh   = liftA acosh-  {-# INLINE acosh #-}--- instance Storable e => Storable (Pixel YCbCr e) where    sizeOf _ = 3 * sizeOf (undefined :: e)@@ -273,59 +219,6 @@ instance Foldable (Pixel YCbCrA) where   foldr f !z (PixelYCbCrA y b r a) = f y (f b (f r (f a z)))   {-# INLINE foldr #-}---instance Num e => Num (Pixel YCbCrA e) where-  (+)         = liftA2 (+)-  {-# INLINE (+) #-}-  (-)         = liftA2 (-)-  {-# INLINE (-) #-}-  (*)         = liftA2 (*)-  {-# INLINE (*) #-}-  abs         = liftA abs-  {-# INLINE abs #-}-  signum      = liftA signum-  {-# INLINE signum #-}-  fromInteger = pure . fromInteger-  {-# INLINE fromInteger #-}---instance Fractional e => Fractional (Pixel YCbCrA e) where-  (/)          = liftA2 (/)-  {-# INLINE (/) #-}-  recip        = liftA recip-  {-# INLINE recip #-}-  fromRational = pure . fromRational-  {-# INLINE fromRational #-}---instance Floating e => Floating (Pixel YCbCrA e) where-  pi      = pure pi-  {-# INLINE pi #-}-  exp     = liftA exp-  {-# INLINE exp #-}-  log     = liftA log-  {-# INLINE log #-}-  sin     = liftA sin-  {-# INLINE sin #-}-  cos     = liftA cos-  {-# INLINE cos #-}-  asin    = liftA asin-  {-# INLINE asin #-}-  atan    = liftA atan-  {-# INLINE atan #-}-  acos    = liftA acos-  {-# INLINE acos #-}-  sinh    = liftA sinh-  {-# INLINE sinh #-}-  cosh    = liftA cosh-  {-# INLINE cosh #-}-  asinh   = liftA asinh-  {-# INLINE asinh #-}-  atanh   = liftA atanh-  {-# INLINE atanh #-}-  acosh   = liftA acosh-  {-# INLINE acosh #-}   instance Storable e => Storable (Pixel YCbCrA e) where

@@ -88,7 +88,7 @@   imgstr <- B.readFile path   let maybeFormat = guessFormat path :: Maybe InputFormat       formats = enumFrom . toEnum $ 0-      orderedFormats = maybe formats (\f -> f:filter (/=f) formats) maybeFormat+      orderedFormats = maybe formats (\f -> f:P.filter (/=f) formats) maybeFormat       reader (Left err) format =          return $ either (Left . ((err++"\n")++)) Right (decode format imgstr)       reader img         _     = return img@@ -132,7 +132,7 @@ -- highest precision 'GIF' supports and it currently cannot be saved with -- transparency. writeImage :: (Array VS cs e, Array arr cs e,-               Exchangable arr VS, Writable (Image VS cs e) OutputFormat) =>+               Writable (Image VS cs e) OutputFormat) =>               FilePath            -- ^ Location where an image should be written.            -> Image arr cs e -- ^ An image to write.             -> IO ()@@ -197,7 +197,7 @@  -} displayImage :: (Array VS cs e, Array arr cs e,-                 Exchangable arr VS, Writable (Image VS cs e) TIF) =>+                 Writable (Image VS cs e) TIF) =>                 Image arr cs e -- ^ Image to be displayed              -> IO () displayImage = displayImageUsing defaultViewer False . exchange VS

@@ -647,7 +647,7 @@  jpImageToImageUnsafe :: (Array VS cs e, JP.Pixel jpx) =>                   JP.Image jpx -> Image VS cs e-jpImageToImageUnsafe (JP.Image n m v) = fromStorableVector (m, n) $ V.unsafeCast v+jpImageToImageUnsafe (JP.Image n m v) = fromVector (m, n) $ V.unsafeCast v   @@ -1068,7 +1068,7 @@  imageToJPImage :: (JP.Pixel a, Array VS cs' e, Array VS cs (JP.PixelBaseComponent a)) =>                   a -> (Pixel cs' e -> Pixel cs (JP.PixelBaseComponent a)) -> Image VS cs' e -> JP.Image a-imageToJPImage _ f !img = JP.Image n m $ V.unsafeCast $ toStorableVector $ I.map f img where+imageToJPImage _ f !img = JP.Image n m $ V.unsafeCast $ toVector $ I.map f img where   !(m, n) = dims img {-# INLINE imageToJPImage #-} 

@@ -247,7 +247,7 @@ makeImageUnsafe   :: (Storable a, Array VS cs e)   => (Int, Int) -> V.Vector a -> Image VS cs e-makeImageUnsafe sz = fromStorableVector sz . V.unsafeCast+makeImageUnsafe sz = fromVector sz . V.unsafeCast   pnmDataPBMToImage :: Int -> Int -> PNM.PpmPixelData -> Either String (Image VS Binary Bit)

@@ -23,7 +23,7 @@ module Graphics.Image.Interface (   Pixel, ColorSpace(..), AlphaSpace(..), Elevator(..),   BaseArray(..), Array(..), MArray(..),-  Exchangable(..), exchangeFrom, exchangeThrough,+  exchange,   defaultIndex, borderIndex, maybeIndex, Border(..), handleBorderIndex,   fromIx, toIx, checkDims #if !MIN_VERSION_base(4,8,0)@@ -36,21 +36,23 @@ #if !MIN_VERSION_base(4,8,0) 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 Data.Word--import Control.Monad.Primitive (PrimMonad (..))+import qualified Data.Vector.Generic as VG+import qualified Data.Vector.Unboxed as VU   -- | 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, Typeable e)+class (Eq cs, Enum cs, Show cs, Bounded cs, Typeable cs, Elevator e, Typeable e,+      Eq (Pixel cs e), VU.Unbox (Components cs e))       => ColorSpace cs e where      type Components cs e@@ -133,7 +135,7 @@ -- >>> toWord8 rgb -- <RGB:(0|128|255)> ---class Elevator e where+class (Eq e, Num e, VU.Unbox e) => Elevator e where    -- | Values are scaled to @[0, 255]@ range.   toWord8 :: e -> Word8@@ -158,13 +160,11 @@   -- | Base array like representation for an image.-class (Show arr, ColorSpace cs e, Num (Pixel cs e),-       SuperClass arr cs e) =>+class (Show arr, ColorSpace cs e, SuperClass arr cs e) =>       BaseArray arr cs e where    -- | Required array specific constraints for an array element.   type SuperClass arr cs e :: Constraint-  type SuperClass arr cs e = ()    -- | Underlying image representation.   data Image arr cs e@@ -179,11 +179,13 @@   --   dims :: Image arr cs e -> (Int, Int) -class (MArray (Manifest arr) cs e, BaseArray arr cs e) => Array arr cs e where+class (VG.Vector (Vector arr) (Pixel cs e),+       MArray (Manifest arr) cs e, BaseArray arr cs e) => Array arr cs e where    type Manifest arr :: *-   +  type Vector arr :: * -> *+   -- | Create an Image by supplying it's dimensions and a pixel generating   -- function.   makeImage :: (Int, Int) -- ^ (@m@ rows, @n@ columns) - dimensions of a new image.@@ -305,16 +307,39 @@   -- the 'Eq' typeclass.   eq :: Eq (Pixel cs e) => 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    toManifest :: Image arr cs e -> Image (Manifest arr) cs e-   +  -- | Convert an image to a flattened 'Vector'. For all current representations+  -- it is a __O(1)__ opeartion.+  --+  -- >>> toVector $ makeImage (3, 2) (\(i, j) -> PixelY $ fromIntegral (i+j))+  -- fromList [<Luma:(0.0)>,<Luma:(1.0)>,<Luma:(1.0)>,<Luma:(2.0)>,<Luma:(2.0)>,<Luma:(3.0)>]+  --+  toVector :: Image arr cs e -> Vector arr (Pixel cs e)++  -- | Construct a two dimensional image with @m@ rows and @n@ columns from a+  --  flat 'Vector' of length @k@. For all current representations it is a+  --  __O(1)__ opeartion. Make sure that @m * n = k@.+  --+  -- >>> fromVector (200, 300) $ generate 60000 (\i -> PixelY $ fromIntegral i / 60000)+  -- <Image Vector Luma: 200x300>+  --+  -- <<images/grad_fromVector.png>>+  -- +  fromVector :: (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+class (BaseArray arr cs e) => MArray arr cs e  where   data MImage s arr cs e-+     unsafeIndex :: Image arr cs e -> (Int, Int) -> Pixel cs e      -- | Get a pixel at @i@-th and @j@-th location.@@ -386,43 +411,19 @@           MImage (PrimState m) arr cs e -> (Int, Int) -> (Int, Int) -> m ()  --- | Allows for changing an underlying image representation.-class Exchangable arr' arr where--  -- | Exchange the underlying array representation of an image.-  exchange :: (Array arr' cs e, Array arr cs e) =>-              arr -- ^ New representation of an image.-           -> Image arr' cs e -- ^ Source image.-           -> Image arr cs e---- | Changing to the same array representation as before is disabled and `exchange`--- will behave simply as an identitity function.-instance Exchangable arr arr where--  exchange _ !img = img-  {-# INLINE exchange #-}----- | `exchange` function that allows restricting representation type of the--- source image.-exchangeFrom :: (Exchangable arr' arr, Array arr' cs e, Array arr cs e) =>-                arr'-             -> arr -- ^ New representation of an image.-             -> Image arr' cs e -- ^ Source image.-             -> Image arr cs e-exchangeFrom _ to !img = exchange to img-{-# INLINE exchangeFrom #-}+-- | Exchange the underlying array representation of an image.+exchange :: (Array arr' cs e, Array arr cs e) =>+            arr -- ^ New representation of an image.+         -> Image arr' cs e -- ^ Source image.+         -> Image arr cs e+exchange _ img@(dims -> (1, 1)) = scalar $ index00 img+exchange _ img = fromVector (dims img) $ VG.convert $ toVector img+{-# INLINE[0] exchange #-}  --- | `exchange` an image representation through an intermediate one.-exchangeThrough :: (Exchangable arr2 arr1, Exchangable arr1 arr,-                    Array arr2 cs e, Array arr1 cs e, Array arr cs e) =>-                arr1-             -> arr -- ^ New representation of an image.-             -> Image arr2 cs e -- ^ Source image.-             -> Image arr cs e-exchangeThrough through to = exchange to . exchange through-{-# INLINE exchangeThrough #-}+{-# RULES+"exchange/id" forall arr. exchange arr = id+ #-}   -- | Approach to be used near the borders during various transformations.@@ -467,31 +468,7 @@               --   deriving Show --- handleBorderIndex' :: Border px -- ^ Border handling strategy.---                   -> (Int, Int) -- ^ Image dimensions---                   -> ((Int, Int) -> px) -- ^ Image's indexing function.---                   -> (Int, Int) -- ^ @(i, j)@ location of a pixel lookup.---                   -> px--- handleBorderIndex' border !(m, n) !getPx !(i, j) =---   if i >= 0 && j >= 0 && i < m && j < n then getPx (i, j) else getPxB border where---     getPxB (Fill px) = px---     getPxB Wrap      = getPx (i `mod` m, j `mod` n)---     getPxB Edge      = getPx (if i < 0 then 0 else if i >= m then m - 1 else i,---                               if j < 0 then 0 else if j >= n then n - 1 else j)---     getPxB Reflect   = getPx (if i < 0 then (abs i - 1) `mod` m else---                                 if i >= m then (m - (i - m + 1)) `mod` m else i,---                               if j < 0 then (abs j - 1) `mod` n else---                                 if j >= n then (n - (j - n + 1)) `mod` n else j)---     getPxB Continue  = getPx (if i < 0 then abs i `mod` m else---                                 if i >= m then (m - (i - m + 2)) `mod` m else i,---                               if j < 0 then abs j `mod` n else---                                 if j >= n then (n - (j - n + 2)) `mod` n else j)---     {-# INLINE getPxB #-}--- {-# INLINE handleBorderIndex' #-} --- -- | Border handling function. If @(i, j)@ location is within bounds, then supplied -- lookup function will be used, otherwise it will be handled according to a -- supplied border strategy.@@ -500,7 +477,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@@ -515,61 +492,15 @@                          if south then (-i - 2) `mod` m else i,                        if west then abs j `mod` n else                          if east then (-j - 2) `mod` n else j)-    -- Reflect  -> getPx (if north then (abs i - 1) `mod` m else-    --                      if south then (m - (i - m + 1)) `mod` m else i,-    --                    if west then (abs j - 1) `mod` n else-    --                      if east then (n - (j - n + 1)) `mod` n else j)-    -- Continue -> getPx (if north then abs i `mod` m else-    --                      if south then (m - (i - m + 2)) `mod` m else i,-    --                    if west then abs j `mod` n else-    --                      if east then (n - (j - n + 2)) `mod` n else j)   else getPx (i, j)   where-    north = i < 0-    {-# INLINE north #-}-    south = i >= m-    {-# INLINE south #-}-    west = j < 0-    {-# INLINE west #-}-    east = j >= n-    {-# INLINE east #-}+    !north = i < 0+    !south = i >= m+    !west  = j < 0+    !east  = j >= n {-# INLINE handleBorderIndex #-}  ---- handleBorderIndex' border !(m, n) getPx !(i, j) =---   case (i < 0, i >= m, j < 0, j >= n) of---     (False, False, False, False) -> getPx (i, j)---     (False, False, False,  True) ->---       case border of---         Fill px -> px---         Wrap -> getPx (i, j `mod` n)---         Edge -> getPx (i, n-1)---         Reflect -> getPx (i, (n - (j - n + 1)) `mod` n)---         Continue -> getPx (i, (n - (j - n + 2)) `mod` n)---     (False, False, True,  False) ->---       case border of---         Fill px -> px---         Wrap -> getPx (i, j `mod` n)---         Edge -> getPx (i, 0)---         Reflect -> getPx (i, (abs j - 1) `mod` n)---         Continue -> getPx (i, abs j `mod` n)---     (False, True, False,  False) ->---       case border of---         Fill px -> px---         Wrap -> getPx (i, j `mod` n)---         Edge -> getPx (i, 0)---         Reflect -> getPx (i, (abs j - 1) `mod` n)---         Continue -> getPx (i, abs j `mod` n)-    --((False, False, False,  True), Edge) -> getPx (i, j `mod` n)-      -  -- case (i >= 0, j >= 0, i < m, j < n) of-  --   (True, True, True, True) -> getPx (i, j)-  --   (True, True, True, True) -> getPx (i, j)-  --   then getPx (i, j) else getPxB border where--- -- | 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@@ -621,11 +552,64 @@ {-# INLINE checkDims #-}  -instance (Applicative (Pixel cs), Bounded e) => Bounded (Pixel cs e) where-  maxBound = pure maxBound+instance (ColorSpace cs e, Num e) => Num (Pixel cs e) where+  (+)         = liftPx2 (+)+  {-# INLINE (+) #-}+  (-)         = liftPx2 (-)+  {-# INLINE (-) #-}+  (*)         = liftPx2 (*)+  {-# INLINE (*) #-}+  abs         = liftPx abs+  {-# INLINE abs #-}+  signum      = liftPx signum+  {-# INLINE signum #-}+  fromInteger = promote . fromInteger+  {-# INLINE fromInteger #-}+  ++instance (ColorSpace cs e, Fractional e) => Fractional (Pixel cs e) where+  (/)          = liftPx2 (/)+  {-# INLINE (/) #-}+  recip        = liftPx recip+  {-# INLINE recip #-}+  fromRational = promote . fromRational+  {-# INLINE fromRational #-}+++instance (ColorSpace cs e, Floating e) => Floating (Pixel cs e) where+  pi      = promote pi+  {-# INLINE pi #-}+  exp     = liftPx exp+  {-# INLINE exp #-}+  log     = liftPx log+  {-# INLINE log #-}+  sin     = liftPx sin+  {-# INLINE sin #-}+  cos     = liftPx cos+  {-# INLINE cos #-}+  asin    = liftPx asin+  {-# INLINE asin #-}+  atan    = liftPx atan+  {-# INLINE atan #-}+  acos    = liftPx acos+  {-# INLINE acos #-}+  sinh    = liftPx sinh+  {-# INLINE sinh #-}+  cosh    = liftPx cosh+  {-# INLINE cosh #-}+  asinh   = liftPx asinh+  {-# INLINE asinh #-}+  atanh   = liftPx atanh+  {-# INLINE atanh #-}+  acosh   = liftPx acosh+  {-# INLINE acosh #-}+++instance (ColorSpace cs e, Bounded e) => Bounded (Pixel cs e) where+  maxBound = promote maxBound   {-# INLINE maxBound #-}   -  minBound = pure minBound+  minBound = promote minBound   {-# INLINE minBound #-}  

@@ -11,7 +11,7 @@ -- module Graphics.Image.Interface.Repa (   -- * Conversion-  --fromRepaArrayS, fromRepaArrayP,+  fromRepaArrayS, fromRepaArrayP,   toRepaArray,   -- * Representation   RSU(..), RPU(..), RSS(..), RPS(..)@@ -19,108 +19,25 @@  import Data.Array.Repa.Index import qualified Data.Array.Repa as R+import qualified Data.Vector.Generic as VG  import Graphics.Image.Interface import Graphics.Image.Interface.Repa.Generic import Graphics.Image.Interface.Repa.Storable import Graphics.Image.Interface.Repa.Unboxed-import Graphics.Image.Interface.Vector  --- | Makes a copy of an image into a Storable Vector representation.-instance Exchangable VU RSS where-  exchange = exchangeThrough VS-  {-# INLINE exchange #-} ---- | Makes a copy of an image into a Storable Vector representation.-instance Exchangable VU RPS where-  exchange = exchangeThrough VS-  {-# INLINE exchange #-}------ | Makes a copy of an image into a Storable Vector representation.-instance Exchangable VS RSU where-  exchange = exchangeThrough VU-  {-# INLINE exchange #-}----- | Makes a copy of an image into a Storable Vector representation.-instance Exchangable VS RPU where-  exchange = exchangeThrough VU-  {-# INLINE exchange #-}----- | Makes a copy of an image into a Storable Vector representation.-instance Exchangable RSU VS where-  exchange _ = exchange VS . toManifest-  {-# INLINE exchange #-}----- | Makes a copy of an image into a Storable Vector representation.-instance Exchangable RPU VS where-  exchange _ = exchange VS . toManifest-  {-# INLINE exchange #-}------ | Makes a copy of an image into a Unboxed Vector representation.-instance Exchangable RSS VU where-  exchange _ = exchange VU . toManifest-  {-# INLINE exchange #-}----- | Makes a copy of an image into a Unboxed Vector representation.-instance Exchangable RPS VU where-  exchange _ = exchange VU . toManifest-  {-# INLINE exchange #-}----- | Makes a copy of an image into a Storable representation sequentially.-instance Exchangable RSU RSS where-  exchange _ (SUImage (SScalar px)) = SSImage (SScalar px)-  exchange _ (SUImage img)          = SSImage . compute . SDImage . getDelayedS $ img-  {-# INLINE exchange #-}----- | Makes a copy of an image into a Storable representation sequentially.-instance Exchangable RPU RPS where-  exchange _ (PUImage (PScalar px)) = PSImage (PScalar px)-  exchange _ (PUImage img)          = PSImage . compute . PDImage . getDelayedP $ img-  {-# INLINE exchange #-}----- | Makes a copy of an image into a Unboxed representation sequentially.-instance Exchangable RSS RSU where-  exchange _ (SSImage (SScalar px)) = SUImage (SScalar px)-  exchange _ (SSImage img)          = SUImage . compute . SDImage . getDelayedS $ img-  {-# INLINE exchange #-}----- | Makes a copy of an image into a Unboxed representation sequentially.-instance Exchangable RPS RPU where-  exchange _ (PSImage (PScalar px)) = PUImage (PScalar px)-  exchange _ (PSImage img)          = PUImage . compute . PDImage . getDelayedP $ img-  {-# INLINE exchange #-}-+-- | Create a sequential 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  --- -- | Create a sequential image from a 2D Repa delayed array.--- fromRepaArrayS :: R.Array R.D DIM2 (Pixel cs e) -> Image RS cs e--- fromRepaArrayS = SDImage+-- | Create a parallel 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  --- -- | Create a parallel image from a 2D Repa delayed array.--- fromRepaArrayP :: R.Array R.D DIM2 (Pixel cs e) -> Image RP cs e--- fromRepaArrayP = PDImage---- | Retrieve an underlying Repa array from an image.-toRepaArray-  :: (Array arr cs e, Array RSU cs e, Exchangable arr RSU)-  => Image arr cs e -> R.Array R.U DIM2 (Pixel cs e)-toRepaArray img =-  case exchange RSU img of-    (SUImage (STImage arr)) -> arr-    (SUImage (SDImage arr)) -> R.computeS arr-    (SUImage (SScalar px))  -> R.computeS $ R.fromFunction (Z :. 1 :. 1) $ const px+-- | Convert into Repa Unboxed array from an image.+toRepaArray :: Array arr cs e => Image arr cs e -> R.Array R.U DIM2 (Pixel cs e)+toRepaArray img = R.fromUnboxed (ix2sh (dims img)) $ VG.convert $ toVector img

@@ -26,11 +26,11 @@ 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 Graphics.Image.ColorSpace.Binary (Bit(..)) import Graphics.Image.Interface as I import qualified Graphics.Image.Interface.Vector.Unboxed as IVU-import qualified Graphics.Image.Interface.Vector.Generic as IVG import Graphics.Image.Interface.Repa.Helpers  @@ -56,13 +56,12 @@  instance SuperClass (RS r) cs e => BaseArray (RS r) cs e where   type SuperClass (RS r) cs e =-    (Show r, ColorSpace cs e, Num (Pixel cs e), R.Elt (Pixel cs e), R.Elt e, -     R.Target (Repr (RS r)) (Pixel cs e), R.Source (Repr (RS r)) (Pixel cs e),-     IVU.Unbox e, IVU.Unbox (Components cs e), -     BaseArray (IVG.V r) cs e, Repr (RP r) ~ Repr (RS r))+    (Show 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 (RS r)) R.DIM2 (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)@@ -71,10 +70,13 @@   {-# INLINE dims #-}  -instance (BaseArray (RS r) cs e) => Array (RS r) cs e where+instance (VG.Vector (Vector r) (Pixel cs e),+          MArray (Manifest r) cs e, BaseArray (RS r) cs e) => Array (RS r) cs e where -  type Manifest (RS r) = Manifest (IVG.V r)+  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 #-}@@ -163,10 +165,17 @@   {-# INLINE (|*|) #-}    toManifest _ = error $ "RS.toManifest: Cannot convert generic Repa " ++-                         "representation to a generic Vector."+                         "representation to a generic Vector representation."   {-# INLINE toManifest #-} +  toVector _ = error $ "RS.toVector: Cannot convert generic Repa " +++                        "representation to a generic Vector."+  {-# INLINE toVector #-} +  fromVector _ = error $ "RS.fromVector: Cannot convert to generic Repa " +++                        "from a generic Vector."+  {-# INLINE fromVector #-}+ --------------------- -- Parallel Arrays -- ---------------------@@ -175,13 +184,13 @@  instance SuperClass (RP r) cs e => BaseArray (RP r) cs e where   type SuperClass (RP r) cs e = (-    Show r, ColorSpace cs e, Num (Pixel cs e),-    R.Target (Repr (RP r)) (Pixel cs e), R.Source (Repr (RP r)) (Pixel cs e),-    BaseArray (IVG.V r) cs e, Repr (RP r) ~ Repr (RS r),-    IVU.Unbox e, IVU.Unbox (Components cs e), R.Elt e, R.Elt (Pixel cs e))+    Show 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 (RP r)) R.DIM2 (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)@@ -190,10 +199,13 @@   {-# INLINE dims #-}  -instance (BaseArray (RP r) cs e) => Array (RP r) cs e where+instance (VG.Vector (Vector r) (Pixel cs e),+          MArray (Manifest r) cs e, BaseArray (RP r) cs e) => Array (RP r) cs e where -  type Manifest (RP r) = Manifest (IVG.V r)-  +  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 #-}@@ -294,8 +306,16 @@                          "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 #-} + + ---------------------- -- Helper functions -- ----------------------@@ -309,12 +329,12 @@ {-# INLINE ix2sh #-}  -toRS :: Repr (RP r) ~ Repr (RS r) => Image (RP r) cs e -> Image (RS r) cs e+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 -toRP :: Repr (RP r) ~ Repr (RS r) => Image (RS r) cs e -> Image (RP r) cs e+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@@ -356,6 +376,8 @@     {-# INLINE getNewE #-} {-# INLINE traverseR #-} ++ traverse2R   :: (R.Source r2 c1, R.Source r1 c)   => R.Array r1 DIM2 c@@ -398,7 +420,7 @@   multR-  :: (ColorSpace cs e, IVU.Unbox (Components cs e), Num (Pixel cs e), R.Elt (Pixel cs e),+  :: (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 =@@ -466,7 +488,7 @@   foldIxS-  :: (R.Elt b, R.Source r2 b, IVU.Unbox b) =>+  :: (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

@@ -30,10 +30,10 @@ import Graphics.Image.Interface as I import Graphics.Image.Interface.Repa.Generic import qualified Graphics.Image.Interface.Vector.Storable as IVS-import qualified Graphics.Image.Interface.Vector.Unboxed as IVU   + -- | Repa Array representation backed by Storable Vector, which is computed sequentially.  data RSS = RSS @@ -47,27 +47,26 @@   show RPS = "RepaParallelStorable"    -type instance Repr (RS IVS.S) = R.F--type instance Repr (RP IVS.S) = R.F+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, Num (Pixel cs e),+    (ColorSpace cs e,      Storable e, Storable (Pixel cs e),-     IVU.Unbox e, IVU.Unbox (Components cs e),       R.Elt e, R.Elt (Pixel cs e))   -  data Image RSS cs e = SSImage !(Image (RS IVS.S) cs e)+  newtype Image RSS cs e = SSImage (Image (RS IVS.VS) cs e)                           dims (SSImage img) = dims img   {-# INLINE dims #-}  -instance (BaseArray RSS cs e) => Array RSS cs e where+instance BaseArray RSS cs e => Array RSS cs e where    type Manifest RSS = IVS.VS++  type Vector RSS = Vector IVS.VS      makeImage !sz f = SSImage (makeImage sz f)   {-# INLINE makeImage #-}@@ -128,24 +127,30 @@   toManifest !img = toManifest (compute img)   {-# INLINE toManifest #-} +  toVector = I.toVector . toManifest+  {-# INLINE toVector #-} +  fromVector !sz = SSImage . STImage . fromVectorStorable sz+  {-# INLINE fromVector #-} + instance SuperClass RPS cs e => BaseArray RPS cs e where   type SuperClass RPS cs e =-    (ColorSpace cs e, Num (Pixel cs e),+    (ColorSpace cs e,      Storable e, Storable (Pixel cs e),-     IVU.Unbox e, IVU.Unbox (Components cs e),      R.Elt e, R.Elt (Pixel cs e))   -  data Image RPS cs e = PSImage !(Image (RP IVS.S) cs e)+  newtype Image RPS cs e = PSImage (Image (RP IVS.VS) cs e)                           dims (PSImage img) = dims img   {-# INLINE dims #-}  -instance (BaseArray RPS cs e) => Array RPS cs e where+instance BaseArray RPS cs e => Array RPS cs e where    type Manifest RPS = IVS.VS++  type Vector RPS = Vector IVS.VS      makeImage !sz f = PSImage (makeImage sz f)   {-# INLINE makeImage #-}@@ -201,52 +206,16 @@   (|*|) (PSImage img1) (PSImage img2) = PSImage (img1 |*| img2)   {-# INLINE (|*|) #-} -  toManifest (PSImage (PScalar px)) = scalar px+  toManifest (PSImage (PScalar px))  = scalar px   toManifest (PSImage (PTImage arr)) = fromRepaArrayStorable arr   toManifest !img = toManifest (compute img)   {-# INLINE toManifest #-} ---- | Changes computation strategy. Will casue all fused operations to be computed.-instance Exchangable RPS RSS where-  -  exchange _ (PSImage img) = SSImage (toRS img)-  {-# INLINE exchange #-}----- | Changes computation strategy. Will casue all fused operations to be computed.-instance Exchangable RSS RPS where-  -  exchange _ (SSImage img) = PSImage (toRP img)-  {-# INLINE exchange #-}----- | O(1) - Changes to Repa representation.-instance Exchangable IVS.VS RSS where-  exchange _ !img@(dims -> (1, 1)) = scalar (index00 img)-  exchange _ !img =-    SSImage . STImage . toRepaArrayStorable $ img-  {-# INLINE exchange #-}----- | O(1) - Changes to Repa representation.-instance Exchangable IVS.VS RPS where-  exchange _ !img@(dims -> (1, 1)) = scalar (index00 img)-  exchange _ !img =-    PSImage . PTImage . toRepaArrayStorable $ img-  {-# INLINE exchange #-}----- | Changes to Vector representation.-instance Exchangable RSS IVS.VS where-  exchange _ = toManifest-  {-# INLINE exchange #-}-+  toVector = I.toVector . toManifest+  {-# INLINE toVector #-} --- | Changes to Vector representation.-instance Exchangable RPS IVS.VS where-  exchange _ = toManifest-  {-# INLINE exchange #-}+  fromVector !sz = PSImage . PTImage . fromVectorStorable sz+  {-# INLINE fromVector #-}   fromRepaArrayStorable@@ -254,22 +223,20 @@      Array IVS.VS cs e   => R.Array R.F DIM2 (Pixel cs e) -> Image IVS.VS cs e fromRepaArrayStorable !arr =-  IVS.fromStorableVector (sh2ix (R.extent arr)) $-  VS.unsafeFromForeignPtr0 (R.toForeignPtr arr) sz+  fromVector (sh2ix (R.extent arr)) $+  VS.unsafeFromForeignPtr0 (R.toForeignPtr arr) (m * n)   where-    !sz = sizeOf (undefined :: Pixel cs e) * m * n     (Z :. m :. n) = R.extent arr  -toRepaArrayStorable+fromVectorStorable   :: forall cs e.-     Array IVS.VS cs e-  => Image IVS.VS cs e -> R.Array R.F DIM2 (Pixel cs e)-toRepaArrayStorable !img-  | sz == sz' = R.fromForeignPtr (ix2sh (dims img)) fp-  | otherwise = error $ "toRepaArrayStorable: (impossible) Vector size mismatch: " +++     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 $ IVS.toStorableVector img-    !sz' = sizeOf (undefined :: Pixel cs e) * m * n-    !(m, n) = dims img+    !(fp, sz) = VS.unsafeToForeignPtr0 v+    !sz' = m * n

@@ -41,18 +41,15 @@   show RPU = "RepaParallelUnboxed"    -type instance Repr (RS IVU.U) = R.U--type instance Repr (RP IVU.U) = R.U+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, Num (Pixel cs e),-     IVU.Unbox e, IVU.Unbox (Components cs e),+    (ColorSpace cs e,      R.Elt e, R.Elt (Pixel cs e))   -  data Image RSU cs e = SUImage !(Image (RS IVU.U) cs e)+  newtype Image RSU cs e = SUImage (Image (RS IVU.VU) cs e)                           dims (SUImage img) = dims img   {-# INLINE dims #-}@@ -61,6 +58,8 @@ instance (BaseArray RSU cs e) => Array RSU cs e where    type Manifest RSU = IVU.VU++  type Vector RSU = Vector IVU.VU      makeImage !sz f = SUImage (makeImage sz f)   {-# INLINE makeImage #-}@@ -118,28 +117,33 @@    toManifest (SUImage (SScalar px)) = scalar px   toManifest (SUImage (STImage arr)) =-    IVU.fromUnboxedVector (sh2ix (R.extent arr)) (R.toUnboxed arr)+    fromVector (sh2ix (R.extent arr)) (R.toUnboxed arr)   toManifest !img = toManifest (compute img)   {-# INLINE toManifest #-} +  toVector = I.toVector . toManifest+  {-# INLINE toVector #-} +  fromVector sz = SUImage . STImage . R.fromUnboxed (ix2sh sz)+  {-# INLINE fromVector #-} + instance SuperClass RPU cs e => BaseArray RPU cs e where   type SuperClass RPU cs e =-    (ColorSpace cs e, Num (Pixel cs e),-     IVU.Unbox e, IVU.Unbox (Components cs e),-     R.Elt e, R.Elt (Pixel cs e))+    (ColorSpace cs e, R.Elt e, R.Elt (Pixel cs e))   -  data Image RPU cs e = PUImage !(Image (RP IVU.U) cs e)+  newtype Image RPU cs e = PUImage (Image (RP IVU.VU) cs e)                           dims (PUImage img) = dims img   {-# INLINE dims #-}  -instance (BaseArray RPU cs e) => Array RPU cs e where+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)   {-# INLINE makeImage #-}  @@ -196,48 +200,12 @@    toManifest (PUImage (PScalar px)) = scalar px   toManifest (PUImage (PTImage arr)) =-    IVU.fromUnboxedVector (sh2ix (R.extent arr)) (R.toUnboxed arr)+    fromVector (sh2ix (R.extent arr)) (R.toUnboxed arr)   toManifest !img = toManifest (compute img)   {-# INLINE toManifest #-} ---- | Changes computation strategy. Will casue all fused operations to be computed.-instance Exchangable RPU RSU where-  -  exchange _ (PUImage img)  = SUImage (toRS img)-  {-# INLINE exchange #-}----- | Changes computation strategy. Will casue all fused operations to be computed.-instance Exchangable RSU RPU where-  -  exchange _ (SUImage img)  = PUImage (toRP img)-  {-# INLINE exchange #-}----- | O(1) - Changes to Repa representation.-instance Exchangable IVU.VU RSU where-  exchange _ img@(dims -> (1, 1)) = scalar (index00 img)-  exchange _ img =-    SUImage . STImage . R.fromUnboxed (ix2sh $ dims img) . IVU.toUnboxedVector $ img-  {-# INLINE exchange #-}----- | O(1) - Changes to Repa representation.-instance Exchangable IVU.VU RPU where-  exchange _ img@(dims -> (1, 1)) = scalar (index00 img)-  exchange _ img =-    PUImage . PTImage . R.fromUnboxed (ix2sh $ dims img) . IVU.toUnboxedVector $ img-  {-# INLINE exchange #-}----- | Changes to Vector representation.-instance Exchangable RSU IVU.VU where-  exchange _ = toManifest-  {-# INLINE exchange #-}-+  toVector = I.toVector . toManifest+  {-# INLINE toVector #-} --- | Changes to Vector representation.-instance Exchangable RPU IVU.VU where-  exchange _ = toManifest-  {-# INLINE exchange #-}+  fromVector sz = PUImage . PTImage . R.fromUnboxed (ix2sh sz)+  {-# INLINE fromVector #-}

@@ -1,4 +1,6 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} -- | -- Module      : Graphics.Image.Interface.Vector@@ -11,25 +13,38 @@ module Graphics.Image.Interface.Vector (   -- * Representation   VU(..), VS(..),-  -- * Conversion-  fromUnboxedVector, toUnboxedVector,-  fromStorableVector, toStorableVector,+  -- * Filtering+  filter, ifilter,   -- * Linear index conversion   toIx, fromIx   ) where -import Data.Vector as V (convert)-import Graphics.Image.Interface-import Graphics.Image.Interface.Vector.Generic+import Prelude hiding (filter)+import qualified Data.Vector.Unboxed as U+import Graphics.Image.Interface as I import Graphics.Image.Interface.Vector.Unboxed import Graphics.Image.Interface.Vector.Storable  -instance Exchangable VU VS where-  exchange _ (VUImage (VScalar px))   = VSImage (VScalar px)-  exchange _ (VUImage (VImage m n v)) = VSImage (VImage m n (V.convert v))+-- | Filter out Pixels from an image that do not satisfy the predicate and+-- convert a result into a flat unboxed vector with indexed Pixels.+filter :: Array arr cs e =>+          (Pixel cs e -> Bool) -- ^ The predicate+       -> Image arr cs e -- ^ Source image+       -> U.Vector ((Int, Int), Pixel cs e)+filter f !img = U.filter (f . snd) $ U.imap addIx $ U.convert $ toVector img where+  (_, n) = dims img+  addIx !k !px = (toIx n k, px)  -instance Exchangable VS VU where-  exchange _ (VSImage (VScalar px))   = VUImage (VScalar px)-  exchange _ (VSImage (VImage m n v)) = VUImage (VImage m n (V.convert v))+-- | Filter out Pixels from an image that do not satisfy the index aware+-- predicate and convert a result into a flat unboxed vector with indexed+-- Pixels.+ifilter :: Array arr cs e =>+           ((Int, Int) -> Pixel cs e -> Bool) -- ^ The predicate+        -> Image arr cs e -- ^ Source image+        -> U.Vector ((Int, Int), Pixel cs e)+ifilter f !img = U.filter (uncurry f) $ U.imap addIx $ U.convert $ toVector img where+  (_, n) = dims img+  addIx !k !px = (toIx n k, px)+

@@ -18,7 +18,7 @@ -- Portability : non-portable -- module Graphics.Image.Interface.Vector.Generic (-  V(..), Repr, Image(..), fromVector, toVector+  G(..), Image(..), fromVector   ) where  import Prelude hiding (map, zipWith)@@ -36,49 +36,53 @@ import Graphics.Image.Interface as I  -- | Generic 'Vector' representation.-data V r = V r+data G r = G r -type family Repr arr :: * -> * -instance Show r => Show (V r) where-  show (V r) = "Vector " ++ show r+instance Show r => Show (G r) where+  show (G r) = "Vector " ++ show r -instance SuperClass (V r) cs e => BaseArray (V r) cs e where-  type SuperClass (V r) cs e = (Show r, ColorSpace cs e, Num (Pixel cs e),-                                VG.Vector (Repr (V r)) (Pixel cs e), VG.Vector (Repr (V r)) Int,-                                VG.Vector (Repr (V r)) Bool, NFData ((Repr (V r)) (Pixel cs e)))+instance SuperClass (G r) cs e => BaseArray (G r) cs e where+  type SuperClass (G r) cs e =+    (Show 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))) -  data Image (V r) cs e = VScalar !(Pixel cs e)+  data Image (G r) cs e = VScalar !(Pixel cs e)                         | VImage {-# UNPACK #-} !Int                                  {-# UNPACK #-} !Int-                                 !((Repr (V r)) (Pixel cs e))+                                 !((Vector (G r)) (Pixel cs e))    dims (VImage m n _) = (m, n)   dims (VScalar _)    = (1, 1)   {-# INLINE dims #-}  -instance (MArray (V r) cs e, BaseArray (V r) cs e) => Array (V r) cs e where+instance (VG.Vector (Vector r) (Pixel cs e),+          MArray (G r) cs e, BaseArray (G r) cs e) => Array (G r) cs e where -  type Manifest (V r) = V r+  type Manifest (G r) = G r -  makeImage !(checkDims "(V r).makeImage" -> (m, n)) f =+  type Vector (G r) = Vector r++  makeImage !(checkDims "(G r).makeImage" -> (m, n)) f =     VImage m n $ VG.generate (m * n) (f . toIx n)   {-# INLINE makeImage #-} -  makeImageWindowed sz !((it, jt), (ib, jb)) getWindowPx getBorderPx =+  -- TODO: add checkWithin+  makeImageWindowed !sz !((it, jt), (ib, jb)) getWindowPx getBorderPx =     VImage m n $ VG.create generate where-      !(m, n) = checkDims "(V r).makeImageWindowed" sz-      nestedLoop :: (VG.Mutable (Repr (V r))) s (Pixel cs e)+      !(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-1)) $ \i ->-          VU.forM_ (VU.enumFromN fj (tj-1)) $ \j ->-            MVG.write mv (fromIx n (i,j)) (getPx (i, j))+        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 (Repr (V r))) s (Pixel cs e))+      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@@ -142,7 +146,7 @@   {-# INLINE transpose #-}    -- TODO: add index verification and switch to VG.unsafeBackpermute-  backpermute !(checkDims "(V r).backpermute" -> (m, n)) !f (VImage _ n' v) =+  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 #-}@@ -151,7 +155,7 @@                   then VImage m n . VG.fromList . concat $ ls                   else error "fromLists: Inner lists are of different lengths."     where-      !(m, n) = checkDims "(V r).fromLists" (length ls, length $ head ls)+      !(m, n) = checkDims "(G r).fromLists" (length ls, length $ head ls)   {-# INLINE fromLists #-}    fold !f !px0 (VImage _ _ v) = VG.foldl' f px0 v@@ -184,20 +188,30 @@   eq _ _ = False   {-# INLINE eq #-} -  compute (VImage m n v) = m `seq` n `seq` v `deepseq` (VImage m n v)-  compute (VScalar px)    = px `seq` (VScalar px)+  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 #-} -instance BaseArray (V r) cs e => MArray (V r) cs e where+  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 (V r) cs e = MVImage !Int !Int ((VG.Mutable (Repr (V r))) s (Pixel cs e))+  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 #-}@@ -213,7 +227,7 @@   foldr f !a (VScalar px)   = f px a   {-# INLINE foldr #-} -  makeImageM !(checkDims "(V r).makeImageM" -> (m, n)) !f =+  makeImageM !(checkDims "(G r).makeImageM" -> (m, n)) !f =     VImage m n <$> VG.generateM (m * n) (f . toIx n)   {-# INLINE makeImageM #-} @@ -264,29 +278,3 @@   swap (MVImage _ n mv) !ix1 !ix2 = MVG.swap mv (fromIx n ix1) (fromIx n ix2)   swap _                _    _    = return ()   {-# INLINE swap #-}----- | Convert an image to a flattened  'Vector'. It is a __O(1)__ opeartion.------ >>> toVector $ makeImage (3, 2) (\(i, j) -> PixelY $ fromIntegral (i+j))--- fromList [<Luma:(0.0)>,<Luma:(1.0)>,<Luma:(1.0)>,<Luma:(2.0)>,<Luma:(2.0)>,<Luma:(3.0)>]----toVector :: VG.Vector (Repr (V r)) (Pixel cs e) => Image (V r) cs e -> (Repr (V r)) (Pixel cs e)-toVector (VImage _ _ v) = v-toVector (VScalar px)   = VG.singleton px-{-# INLINE toVector #-}----- | Construct a two dimensional image with @m@ rows and @n@ columns from a flat---  'Vector' of length @k@. It is a __O(1)__ opeartion. Make sure that @m * n = k@.------ >>> fromVector (200, 300) $ generate 60000 (\i -> PixelY $ fromIntegral i / 60000)--- <Image Vector Luma: 200x300>------ <<images/grad_fromVector.png>>--- -fromVector :: (Array (V r) cs e, VG.Vector (Repr (V r)) (Pixel cs e)) => (Int, Int) -> (Repr (V r)) (Pixel cs e) -> Image (V r) cs e-fromVector !(m, n) !v-  | m * n == VG.length v = VImage m n v-  | otherwise = error "fromVector: m * n doesn't equal the length of a Vector."-{-# INLINE fromVector #-}

@@ -18,7 +18,7 @@ -- Portability : non-portable -- module Graphics.Image.Interface.Vector.Storable (-  VS(..), S, Image(..), fromStorableVector, toStorableVector, fromIx, toIx, checkDims+  VS(..), Image(..)   ) where  import Prelude hiding (map, zipWith)@@ -34,21 +34,14 @@ -- | Storable 'Vector' representation. data VS = VS -data S--type instance Repr (V S) = VS.Vector--instance Show S where-  show _ = "Storable"- instance Show VS where   show _ = "VectorStorable"  instance SuperClass VS cs e => BaseArray VS cs e where   type SuperClass VS cs e =-    (ColorSpace cs e, Num (Pixel cs e), VS.Storable (Pixel cs e))+    (ColorSpace cs e, VS.Storable (Pixel cs e)) -  data Image VS cs e = VSImage !(Image (V S) cs e)+  newtype Image VS cs e = VSImage (Image (G VS) cs e)    dims (VSImage img) = dims img   {-# INLINE dims #-}@@ -58,6 +51,8 @@ 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   {-# INLINE makeImage #-}@@ -110,19 +105,24 @@   eq (VSImage img1) (VSImage img2) = img1 == img2   {-# INLINE eq #-} -  compute (VSImage img) = VSImage $! compute img+  compute (VSImage img) = VSImage (compute img)   {-# INLINE compute #-}    toManifest = id   {-# INLINE toManifest #-} +  toVector (VSImage (VImage _ _ v)) = v+  toVector (VSImage (VScalar px))   = VS.singleton px+  {-# INLINE toVector #-} +  fromVector !sz = VSImage . fromVector sz+  {-# INLINE fromVector #-} + instance BaseArray VS cs e => MArray VS cs e where   -  data MImage s VS cs e = MVSImage (MImage s (V S) cs e)+  newtype MImage s VS cs e = MVSImage (MImage s (G VS) cs e)                               -   unsafeIndex (VSImage img) = unsafeIndex img   {-# INLINE unsafeIndex #-} @@ -170,27 +170,3 @@    swap (MVSImage img) = I.swap img   {-# INLINE swap #-}------ | Convert an image to a flattened Storable 'VS.Vector'. It is a __O(1)__ opeartion.------ >>> toStorableVector $ makeImage (3, 2) (\(i, j) -> PixelY $ fromIntegral (i+j))--- fromList [<Luma:(0.0)>,<Luma:(1.0)>,<Luma:(1.0)>,<Luma:(2.0)>,<Luma:(2.0)>,<Luma:(3.0)>]----toStorableVector :: Array VS cs e => Image VS cs e -> VS.Vector (Pixel cs e)-toStorableVector (VSImage img) = toVector img-{-# INLINE toStorableVector #-}----- | Construct a two dimensional image with @m@ rows and @n@ columns from a flat--- Storable 'VS.Vector' of length @k@. It is a __O(1)__ opeartion. Make sure that @m * n = k@.------ >>> fromStorableVector (200, 300) $ generate 60000 (\i -> PixelY $ fromIntegral i / 60000)--- <Image VectorStorable Luma: 200x300>------ <<images/grad_fromVector.png>>--- -fromStorableVector :: Array VS cs e => (Int, Int) -> VS.Vector (Pixel cs e) -> Image VS cs e-fromStorableVector !sz !v = VSImage $ fromVector sz v-{-# INLINE fromStorableVector #-}

@@ -18,7 +18,7 @@ -- Portability : non-portable -- module Graphics.Image.Interface.Vector.Unboxed (-  U, VU(..), VU.Unbox, Image(..), fromUnboxedVector, toUnboxedVector, fromIx, toIx, checkDims+  VU(..), VU.Unbox, Image(..)   ) where  import Prelude hiding (map, zipWith)@@ -35,21 +35,14 @@ -- | Unboxed 'Vector' representation. data VU = VU -data U--type instance Repr (V U) = VU.Vector--instance Show U where-  show _ = "Unboxed"- instance Show VU where   show _ = "VectorUnboxed"  instance SuperClass VU cs e => BaseArray VU cs e where   type SuperClass VU cs e =-    (ColorSpace cs e, Num (Pixel cs e), VU.Unbox (Components cs e))+    (ColorSpace cs e, VU.Unbox (Components cs e)) -  data Image VU cs e = VUImage !(Image (V U) cs e)+  newtype Image VU cs e = VUImage (Image (G VU) cs e)    dims (VUImage img) = dims img   {-# INLINE dims #-}@@ -60,6 +53,8 @@    type Manifest VU = VU +  type Vector VU = VU.Vector+   makeImage !sh = VUImage . makeImage sh   {-# INLINE makeImage #-} @@ -111,18 +106,24 @@   eq (VUImage img1) (VUImage img2) = img1 == img2   {-# INLINE eq #-} -  compute (VUImage img) = VUImage $! compute img+  compute (VUImage img) = VUImage (compute img)   {-# INLINE compute #-}    toManifest = id   {-# INLINE toManifest #-} +  toVector (VUImage (VImage _ _ v)) = v+  toVector (VUImage (VScalar px))   = VU.singleton px+  {-# INLINE toVector #-} +  fromVector !sz = VUImage . fromVector sz+  {-# INLINE fromVector #-}++ instance BaseArray VU cs e => MArray VU cs e where   -  data MImage s VU cs e = MVUImage (MImage s (V U) cs e)+  newtype MImage s VU cs e = MVUImage (MImage s (G VU) cs e)                               -   unsafeIndex (VUImage img) = unsafeIndex img   {-# INLINE unsafeIndex #-} @@ -171,26 +172,3 @@   swap (MVUImage img) = I.swap img   {-# INLINE swap #-} ----- | Convert an image to a flattened Unboxed 'VU.Vector'. It is a __O(1)__ opeartion.------ >>> toUnboxedVector $ makeImage (3, 2) (\(i, j) -> PixelY $ fromIntegral (i+j))--- fromList [<Luma:(0.0)>,<Luma:(1.0)>,<Luma:(1.0)>,<Luma:(2.0)>,<Luma:(2.0)>,<Luma:(3.0)>]----toUnboxedVector :: Array VU cs e => Image VU cs e -> VU.Vector (Pixel cs e)-toUnboxedVector (VUImage img) = toVector img-{-# INLINE toUnboxedVector #-}----- | Construct a two dimensional image with @m@ rows and @n@ columns from a flat--- Unboxed 'VU.Vector' of length @k@. It is a __O(1)__ opeartion. Make sure that @m * n = k@.------ >>> fromUnboxedVector (200, 300) $ generate 60000 (\i -> PixelY $ fromIntegral i / 60000)--- <Image VectorUnboxed Luma: 200x300>------ <<images/grad_fromVector.png>>--- -fromUnboxedVector :: Array VU cs e => (Int, Int) -> VU.Vector (Pixel cs e) -> Image VU cs e-fromUnboxedVector !sz !v = VUImage $ fromVector sz v-{-# INLINE fromUnboxedVector #-}

@@ -6,7 +6,7 @@ {-# LANGUAGE UndecidableInstances #-} -- | -- Module      : Graphics.Image.Interface.Vector.Unboxing--- Copyright   : (c) Alexey Kuleshevich 2016+-- Copyright   : (c) Alexey Kuleshevich 2017 -- License     : BSD3 -- Maintainer  : Alexey Kuleshevich <lehins@yandex.ru> -- Stability   : experimental@@ -14,76 +14,19 @@ -- module Graphics.Image.Interface.Vector.Unboxing where -import Data.Word-import Graphics.Image.Interface-import Graphics.Image.ColorSpace.Binary (Bit(..))-import qualified Data.Vector.Generic            as V-import qualified Data.Vector.Generic.Mutable    as M-import qualified Data.Vector.Unboxed            as U import Control.Monad---- | Unboxing of a `Bit`.-instance U.Unbox Bit--newtype instance U.MVector s Bit = MV_Bit (U.MVector s Word8)--instance M.MVector U.MVector Bit where-  basicLength (MV_Bit mvec) = M.basicLength mvec-  {-# INLINE basicLength #-}-  basicUnsafeSlice idx len (MV_Bit mvec) = MV_Bit (M.basicUnsafeSlice idx len mvec)-  {-# INLINE basicUnsafeSlice #-}-  basicOverlaps (MV_Bit mvec) (MV_Bit mvec') = M.basicOverlaps mvec mvec'-  {-# INLINE basicOverlaps #-}-  basicUnsafeNew len = MV_Bit `liftM` M.basicUnsafeNew len-  {-# INLINE basicUnsafeNew #-}-  basicUnsafeReplicate len (Bit w) = MV_Bit `liftM` M.basicUnsafeReplicate len w-  {-# INLINE basicUnsafeReplicate #-}-  basicUnsafeRead (MV_Bit mvec) idx = Bit `liftM` M.basicUnsafeRead mvec idx-  {-# INLINE basicUnsafeRead #-}-  basicUnsafeWrite (MV_Bit mvec) idx (Bit w) = M.basicUnsafeWrite mvec idx w-  {-# INLINE basicUnsafeWrite #-}-  basicClear (MV_Bit mvec) = M.basicClear mvec-  {-# INLINE basicClear #-}-  basicSet (MV_Bit mvec) (Bit w) =  M.basicSet mvec w-  {-# INLINE basicSet #-}-  basicUnsafeCopy (MV_Bit mvec) (MV_Bit mvec') = M.basicUnsafeCopy mvec mvec'-  {-# INLINE basicUnsafeCopy #-}-  basicUnsafeMove (MV_Bit mvec) (MV_Bit mvec') = M.basicUnsafeMove mvec mvec'-  {-# INLINE basicUnsafeMove #-}-  basicUnsafeGrow (MV_Bit mvec) len = MV_Bit `liftM` M.basicUnsafeGrow mvec len-  {-# INLINE basicUnsafeGrow #-}-#if MIN_VERSION_vector(0,11,0)-  basicInitialize (MV_Bit mvec) = M.basicInitialize mvec-  {-# INLINE basicInitialize #-}-#endif---newtype instance U.Vector Bit = V_Bit (U.Vector Word8)--instance V.Vector U.Vector Bit where-  basicUnsafeFreeze (MV_Bit mvec) = V_Bit `liftM` V.basicUnsafeFreeze mvec-  {-# INLINE basicUnsafeFreeze #-}-  basicUnsafeThaw (V_Bit vec) = MV_Bit `liftM` V.basicUnsafeThaw vec-  {-# INLINE basicUnsafeThaw #-}-  basicLength (V_Bit vec) = V.basicLength vec-  {-# INLINE basicLength #-}-  basicUnsafeSlice idx len (V_Bit vec) = V_Bit (V.basicUnsafeSlice idx len vec)-  {-# INLINE basicUnsafeSlice #-}-  basicUnsafeIndexM (V_Bit vec) idx = Bit `liftM` V.basicUnsafeIndexM vec idx-  {-# INLINE basicUnsafeIndexM #-}-  basicUnsafeCopy (MV_Bit mvec) (V_Bit vec) = V.basicUnsafeCopy mvec vec-  {-# INLINE basicUnsafeCopy #-}-  elemseq (V_Bit vec) (Bit w) = V.elemseq vec w-  {-# INLINE elemseq #-}-+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   -- | Unboxing of a `Pixel`.-instance (ColorSpace cs e, U.Unbox (Components cs e)) => U.Unbox (Pixel cs e)+instance ColorSpace cs e => U.Unbox (Pixel cs e)  newtype instance U.MVector s (Pixel cs e) = MV_Pixel (U.MVector s (Components cs e)) -instance (ColorSpace cs e, U.Unbox (Components cs e)) => M.MVector U.MVector (Pixel cs e) where+instance ColorSpace cs e => M.MVector U.MVector (Pixel cs e) where   basicLength (MV_Pixel mvec) = M.basicLength mvec   {-# INLINE basicLength #-}   basicUnsafeSlice idx len (MV_Pixel mvec) = MV_Pixel (M.basicUnsafeSlice idx len mvec)@@ -116,7 +59,7 @@  newtype instance U.Vector (Pixel cs e) = V_Pixel (U.Vector (Components cs e)) -instance (ColorSpace cs e, U.Unbox (Components cs e)) => V.Vector U.Vector (Pixel cs e) where+instance (ColorSpace cs e) => V.Vector U.Vector (Pixel cs e) where   basicUnsafeFreeze (MV_Pixel mvec) = V_Pixel `liftM` V.basicUnsafeFreeze mvec   {-# INLINE basicUnsafeFreeze #-}   basicUnsafeThaw (V_Pixel vec) = MV_Pixel `liftM` V.basicUnsafeThaw vec

@@ -51,8 +51,8 @@ -- >>> frog .<. flipH frog   -- (or: flipH frog .>. frog) -- class Array arr Binary Bit => Thresholding a b arr | a b -> arr where-  (.==.) :: (Eq (Pixel cs e), Array arr cs e)  => a cs e -> b cs e -> Image arr Binary Bit-  (./=.) :: (Eq (Pixel cs e), 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+  (./=.) :: 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

@@ -31,7 +31,7 @@  -- | Fast Fourier Transform fft :: (Applicative (Pixel cs),-        Array arr cs (Complex e),+        Array arr cs (Complex e), ColorSpace cs e,         Fractional (Pixel cs (Complex e)), Floating (Pixel cs e), RealFloat e) =>        Image arr cs (Complex e)     -> Image arr cs (Complex e)@@ -41,7 +41,7 @@  -- | Inverse Fast Fourier Transform ifft :: (Applicative (Pixel cs),-         Array arr cs (Complex e),+         Array arr cs (Complex e), ColorSpace cs e,          Fractional (Pixel cs (Complex e)), Floating (Pixel cs e), RealFloat e) =>         Image arr cs (Complex e)      -> Image arr cs (Complex e)@@ -63,7 +63,7 @@  -- | Compute the DFT of a matrix. Array dimensions must be powers of two else `error`. fft2d :: (Applicative (Pixel cs),-          Array arr cs (Complex e),+          Array arr cs (Complex e), ColorSpace cs e,           Fractional (Pixel cs (Complex e)), Floating (Pixel cs e), RealFloat e) =>          Mode       -> Image arr cs (Complex e)@@ -84,7 +84,7 @@   fftGeneral :: (Applicative (Pixel cs),-               Array arr cs (Complex e),+               Array arr cs (Complex e), ColorSpace cs e,                 Floating (Pixel cs e), RealFloat e) =>               Pixel cs e            -> Image arr cs (Complex e)@@ -109,8 +109,7 @@   -- Compute a twiddle factor.-twiddle :: (Applicative (Pixel cs),-            Floating (Pixel cs e)) =>+twiddle :: (Applicative (Pixel cs), Floating (Pixel cs e)) =>            Pixel cs e         -> Int                  -- index         -> Int                  -- length

@@ -9,63 +9,42 @@ -- Portability : non-portable -- module Graphics.Image.Processing.Convolution (-  convolve, convolveRows, convolveCols+  convolve, convolveRows, convolveCols, correlate   ) where  import Prelude as P++import Graphics.Image.ColorSpace import Graphics.Image.Interface as I---import Graphics.Image.Interface.Vector.Sparse import Graphics.Image.Processing.Geometric   -convolve' :: Array arr cs e =>-              Border (Pixel cs e) -> Image arr cs e -> Image arr cs e -> Image arr cs e-convolve' !border !kernel !img =-  traverse2 (compute kernel) (compute img) (const . const sz) stencil++-- | Correlate an image using a kernel. Border resolution technique is required.+correlate :: I.Array arr cs e =>+                  Border (Pixel cs e) -> Image arr cs e -> Image arr cs e -> Image arr cs e+correlate !border !kernel !img =+  I.traverse (compute img) (const sz) stencil   where-    !(krnM, krnN)     = dims kernel-    !krnM2            = krnM `div` 2-    !krnN2            = krnN `div` 2-    !sz               = dims img-    getPxB !getPx !ix = handleBorderIndex border sz getPx ix+    !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 !getKrnPx !getImgPx !(i, j) = integrate 0 0 0 where+    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 = getKrnPx (ki, kj)+        | 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 #-}-{-# INLINE convolve' #-}---- convolveSparse :: (Exchangable arr VS, Array arr cs e, Array VS cs e)  =>---                    Border (Pixel cs e) -> Image arr cs e -> Image arr cs e -> Image arr cs e--- convolveSparse !border !kernel !img =---   makeImageWindowed---     sz---     ((krnM2, krnN2), (m - krnM2, n - krnN2))---     (stencil (unsafeIndex imgM))---     (stencil (borderIndex border imgM))---   where---     !imgM = toManifest img---     !kernel' = exchange VS $ compute kernel---     -- !kernel' = exchange VS kernel -- deadlock?!?!?---     !(krnM, krnN) = dims kernel'---     !krnM2 = krnM `div` 2---     !krnN2 = krnN `div` 2---     !sz@(m, n) = dims img---     stencil getPx !(i, j) = foldIx integral 0 kernel'---       where---         integral !acc !(ki, kj) !px = px * (getPx (ki + ikrnM, kj + jkrnN)) + acc---         {-# INLINE integral #-}---         !ikrnM = i - krnM2---         !jkrnN = j - krnN2---     {-# INLINE stencil #-}--- {-# INLINE convolveSparse #-}+{-# INLINE correlate #-}   -- | Convolution of an image using a kernel. Border resolution technique is required.@@ -84,7 +63,7 @@           -> Image arr cs e -- ^ Kernel image.           -> Image arr cs e -- ^ Source image.           -> Image arr cs e-convolve !out = convolve' out . rotate180+convolve !out = correlate out . rotate180 {-# INLINE convolve #-}  

@@ -19,7 +19,7 @@ class Interpolation method where    -- | Construct a new pixel by using information from neighboring pixels.-  interpolate :: (Num (Pixel cs e), ColorSpace cs e) =>+  interpolate :: ColorSpace cs e =>                  method -- ^ Interpolation method               -> Border (Pixel cs e) -- ^ Border resolution strategy               -> (Int, Int)          -- ^ Image dimensions @m@ rows and @n@ columns.

@@ -11,7 +11,7 @@   module Graphics.Image.ColorSpace,   module Graphics.Image.IO.Formats,   Array, Image, MArray, MImage,-  Exchangable, Border(..),+  Border(..),   VU(..), VS(..), RSU(..), RPU(..), RSS(..), RPS(..)   ) where @@ -83,6 +83,7 @@   ---{-# RULES---"I.map/id" forall img. I.map id img = img--- #-}+-- {-# RULES+-- "I.map/id" forall img. I.map id img = img+-- "I.map/I.makeImage" forall f g sz. I.map f (I.makeImage sz g) = I.makeImage sz (f . g)+--  #-}

@@ -0,0 +1,25 @@+{-# LANGUAGE FlexibleContexts #-}+module Graphics.Image.Interface.RepaSpec (spec) where++import Test.Hspec+import Test.QuickCheck++import Graphics.Image as I+import Graphics.Image.Interface.Repa++import Graphics.Image.InterfaceSpec ()++prop_toFromRepaS+  :: Image RSU Y Word8 -> Bool+prop_toFromRepaS img = img == fromRepaArrayS (toRepaArray img)++prop_toFromRepaP+  :: Image RSU Y Word8 -> Bool+prop_toFromRepaP img = img == fromRepaArrayS (toRepaArray img)+++spec :: Spec+spec = do+  describe "Vector Representation Properties" $ do+    it "toFromRepaS" $ property $ prop_toFromRepaS+    it "toFromRepaP" $ property $ prop_toFromRepaP

@@ -4,8 +4,7 @@ import Test.Hspec import Test.QuickCheck -import Graphics.Image as I-import Graphics.Image.Interface.Vector+import Graphics.Image.Interface as I  import Graphics.Image.InterfaceSpec () @@ -16,13 +15,8 @@ prop_toFromIx :: Positive Int -> NonNegative Int -> Bool prop_toFromIx (Positive n) (NonNegative k) = k == fromIx n (toIx n k) -prop_toFromVector-  :: Image VU Y Word8 -> Bool-prop_toFromVector img = img == fromUnboxedVector (dims img) (toUnboxedVector img)- spec :: Spec spec = do-  describe "Vector Representation Properties" $ do+  describe "Vector Index Properties" $ do     it "fromToIx" $ property $ prop_fromToIx     it "toFromIx" $ property $ prop_toFromIx-    it "toFromVector" $ property $ prop_toFromVector

@@ -45,11 +45,16 @@ instance Arbitrary (Pixel RGB Double) where   arbitrary = PixelRGB <$> arbitraryDouble <*> arbitraryDouble <*> arbitraryDouble -instance (Array arr cs e, MArray arr cs e, Arbitrary (Pixel cs e)) =>+instance (Array arr cs e, Arbitrary (Pixel cs e)) =>          Arbitrary (Image arr cs e) where   arbitrary = do     (Positive (Small m), Positive (Small n)) <- arbitrary-    I.makeImageM (m, n) (const arbitrary)+    getPx <- arbitrary+    if (m, n) == (1, 1)+      then do+      elements [I.makeImage (m, n) getPx, I.scalar (getPx (0, 0))]+      else+      return $ I.makeImage (m, n) getPx    shrink img | dims img == (1,1) = []              | rows img == 1 = [downsampleCols img]@@ -166,25 +171,25 @@ prop_sameDims _ (Identical img1 img2) = I.dims img1 == I.dims img2  prop_sameImage-  :: (Exchangable arr VU, Array arr RGB Word8)+  :: Array arr RGB Word8   => arr -> Identical VU arr RGB Word8 -> Bool prop_sameImage _ (Identical img1 img2) = img1 == I.exchange VU img2  prop_sameMap-  :: (Exchangable arr RSU, Array arr Y Word8)+  :: Array arr Y Word8   => arr -> (Pixel Y Word8 -> Pixel Y Word8) -> Identical VU arr Y Word8 -> Bool prop_sameMap _ f (Identical img1 img2) =   I.exchange RSU (I.map f img1) == I.exchange RSU (I.map f img2)  prop_sameImap-  :: (Exchangable arr RPU, Array arr Y Word8)+  :: Array arr Y Word8   => arr -> ((Int, Int) -> Pixel Y Word8 -> Pixel Y Word8) -> Identical VU arr Y Word8 -> Bool prop_sameImap _ f (Identical img1 img2) =   I.exchange RPU (I.imap f img1) == I.exchange RPU (I.imap f img2)   prop_sameZipWith-  :: (Exchangable arr RPU, Array arr Y Word8)+  :: Array arr Y Word8   => arr   -> (Pixel Y Word8 -> Pixel Y Word8)   -> (Pixel Y Word8 -> Pixel Y Word8 -> Pixel Y Word8)@@ -198,7 +203,7 @@     img2' = I.map g img2  prop_sameIZipWith-  :: (Exchangable arr RPU, Array arr Y Word8)+  :: Array arr Y Word8   => arr   -> (Pixel Y Word8 -> Pixel Y Word8)   -> ((Int, Int) -> Pixel Y Word8 -> Pixel Y Word8 -> Pixel Y Word8)@@ -212,7 +217,7 @@     img2' = I.map g img2  prop_sameTraverse-  :: (Exchangable arr RSU, Array arr Y Word8)+  :: Array arr Y Word8   => arr   -> ((Int, Int) -> (Positive (Small Int), Positive (Small Int)))   -> ((Int, Int) -> Pixel Y Word8 -> Pixel Y Word8)@@ -228,7 +233,7 @@   prop_sameTraverse2-  :: (Exchangable arr RSU, Array arr Y Word8)+  :: Array arr Y Word8   => arr   -> ((Int, Int) -> (Int, Int) -> (Positive (Small Int), Positive (Small Int)))   -> ((Int, Int) -> Pixel Y Word8 -> Pixel Y Word8 -> Pixel Y Word8)@@ -249,7 +254,7 @@   prop_sameTranspose-  :: (Exchangable arr RSU, Array arr Y Word8)+  :: Array arr Y Word8   => arr   -> Identical VU arr Y Word8   -> Bool@@ -258,7 +263,7 @@   prop_sameBackpermute-  :: (Exchangable arr RPU, Array arr Y Word8)+  :: Array arr Y Word8   => arr   -> (Positive (Small Int), Positive (Small Int))   -> ((Int, Int) -> (Int, Int))@@ -275,12 +280,22 @@ prop_toFormLists :: (Array arr Y Word8, MArray arr Y Word8) => arr -> Image arr Y Word8 -> Bool prop_toFormLists _ img = img == I.fromLists (I.toLists img) +prop_toFromVector :: Array arr Y Word8 => arr -> Image arr Y Word8 -> Bool+prop_toFromVector _ img = img == fromVector (dims img) (toVector img) + spec :: Spec spec = do   describe "Interface Properties" $ do     it "borderIndex" $ property prop_borderIndex-    it "toFormLists" $ property $ prop_toFormLists VU+    it "toFormLists VU" $ property $ prop_toFormLists VU+    it "toFormLists VS" $ property $ prop_toFormLists VS+    it "toFromVector VU" $ property $ prop_toFromVector VU+    it "toFromVector VS" $ property $ prop_toFromVector VS+    it "toFromVector RPU" $ property $ prop_toFromVector RPU+    it "toFromVector RSU" $ property $ prop_toFromVector RSU+    it "toFromVector RPS" $ property $ prop_toFromVector RPS+    it "toFromVector RSS" $ property $ prop_toFromVector RSS   describe "Representation Properties" $ do     it "sameDims VS" $ property $ prop_sameDims VS     it "sameDims RSU" $ property $ prop_sameDims RSU@@ -288,27 +303,27 @@     it "sameImage VS" $ property $ prop_sameImage VS     it "sameImage RSU" $ property $ prop_sameImage RSU     it "sameImage RPU" $ property $ prop_sameImage RPU-    --it "sameMap VS" $ property $ prop_sameMap VS+    it "sameMap VS" $ property $ prop_sameMap VS     it "sameMap RSU" $ property $ prop_sameMap RSU     it "sameMap RPU" $ property $ prop_sameMap RPU-    --it "sameImap VS" $ property $ prop_sameImap VS+    it "sameImap VS" $ property $ prop_sameImap VS     it "sameImap RSU" $ property $ prop_sameImap RSU     it "sameImap RPU" $ property $ prop_sameImap RPU-    --it "sameZipWith VS" $ property $ prop_sameZipWith VS+    it "sameZipWith VS" $ property $ prop_sameZipWith VS     it "sameZipWith RSU" $ property $ prop_sameZipWith RSU     it "sameZipWith RPU" $ property $ prop_sameZipWith RPU-    --it "sameIZipWith VS" $ property $ prop_sameIZipWith VS+    it "sameIZipWith VS" $ property $ prop_sameIZipWith VS     it "sameIZipWith RSU" $ property $ prop_sameIZipWith RSU     it "sameIZipWith RPU" $ property $ prop_sameIZipWith RPU-    --it "sameTraverse VS" $ property $ prop_sameTraverse VS+    it "sameTraverse VS" $ property $ prop_sameTraverse VS     it "sameTraverse RSU" $ property $ prop_sameTraverse RSU     it "sameTraverse RPU" $ property $ prop_sameTraverse RPU-    --it "sameTraverse2 VS" $ property $ prop_sameTraverse2 VS+    it "sameTraverse2 VS" $ property $ prop_sameTraverse2 VS     it "sameTraverse2 RSU" $ property $ prop_sameTraverse2 RSU     it "sameTraverse2 RPU" $ property $ prop_sameTraverse2 RPU-    --it "sameTranspose VS" $ property $ prop_sameTranspose VS+    it "sameTranspose VS" $ property $ prop_sameTranspose VS     it "sameTranspose RSU" $ property $ prop_sameTranspose RSU     it "sameTranspose RPU" $ property $ prop_sameTranspose RPU-    --it "sameBackpermute VS" $ property $ prop_sameBackpermute VS+    it "sameBackpermute VS" $ property $ prop_sameBackpermute VS     it "sameBackpermute RSU" $ property $ prop_sameBackpermute RSU     it "sameBackpermute RPU" $ property $ prop_sameBackpermute RPU