Update tests, and array validation logic.

Author: dmjio

arrayfire.cabal

@@ -138,6 +138,8 @@ test-suite test
     directory,
     hspec,
     hspec-discover,
+    QuickCheck,
+    quickcheck-classes,
     vector
   default-language:
     Haskell2010

default.nix

@@ -1,8 +1,9 @@
 { pkgs ? import <nixpkgs> { config.allowUnfree = true; } }:
 # Latest arrayfire is not yet procured w/ nix.
 let
-  af = pkgs.callPackage ./nix {};
-  pkg = pkgs.haskellPackages.callCabal2nix "arrayfire" ./. { inherit af; };
+  pkg = pkgs.haskellPackages.callCabal2nix "arrayfire" ./. {
+    af = null;
+    quickcheck-classes = pkgs.haskellPackages.quickcheck-classes_0_6_4_0;
+  };
 in
-  with pkgs.haskell.lib;
-  enableCabalFlag pkg "disable-default-paths"
+  pkg

src/ArrayFire/Array.hs

@@ -37,6 +37,7 @@
 module ArrayFire.Array where
 
 import           Control.Exception
+import           Control.Monad
 import           Data.Proxy
 import           Data.Vector.Storable       hiding (mapM_, take, concat, concatMap)
 import qualified Data.Vector.Storable       as V
@@ -106,7 +107,7 @@ cube (x,y,z)
   . concat
   . fmap concat
   . take x
-  . (fmap . take) y
+  . fmap (take y)
   . (fmap . fmap . take) z
 
 -- | Smart constructor for creating a tensor 'Array'
@@ -158,7 +159,14 @@ mkArray
   -- ^ Returned array
 {-# NOINLINE mkArray #-}
 mkArray dims xs =
-  unsafePerformIO . mask_ $ do
+  unsafePerformIO $ do
+    when (Prelude.length (take size xs) < size) $ do
+      let msg = "Invalid elements provided. "
+           <> "Expected "
+           <> show size
+           <> " elements received "
+           <> show (Prelude.length xs)
+      throwIO (AFException SizeError 203 msg)
     dataPtr <- castPtr <$> newArray (Prelude.take size xs)
     let ndims = fromIntegral (Prelude.length dims)
     alloca $ \arrayPtr -> do
@@ -169,7 +177,7 @@ mkArray dims xs =
       arr <- peek arrayPtr
       Array <$> newForeignPtr af_release_array_finalizer arr
     where
-      size  = Prelude.product (fromIntegral <$> dims)
+      size  = Prelude.product dims
       dType = afType (Proxy @ array)
 
 -- af_err af_create_handle(af_array *arr, const unsigned ndims, const dim_t * const dims, const af_dtype type);

src/ArrayFire/Data.hs

@@ -428,6 +428,11 @@ moddims (Array fptr) dims =
 -- ArrayFire Array
 -- [4 1 1 1]
 --    1.0000     2.0000     1.0000     2.0000
+--
+-- >>> flat $ cube @Int (2,2,2) [[[1,1],[1,1]],[[1,1],[1,1]]]
+-- ArrayFire Array
+-- [8 1 1 1]
+--     1          1          1          1          1          1          1          1
 flat
   :: Array a
   -> Array a

test/ArrayFire/ArraySpec.hs

@@ -45,7 +45,7 @@ spec =
       setManualEvalFlag False
       (`shouldBe` False) =<< getManualEvalFlag
     it "Should return the number of elements" $ do
-      let arr = mkArray @Int [9,9,1,1] []
+      let arr = mkArray @Int [9,9,1,1] [1..]
       getElements arr `shouldBe` 81
 --    it "Should give an empty array" $ do
 --      let arr = mkArray @Int [-1,1,1,1] []
@@ -57,9 +57,9 @@ spec =
     it "Should get number of dims specified" $ do
       let arr = mkArray @Int [1,1,1,1] [1]
       getNumDims arr `shouldBe` 1
-      let arr = mkArray @Int [2,3,4,5] [1]
+      let arr = mkArray @Int [2,3,4,5] [1..]
       getNumDims arr `shouldBe` 4
-      let arr = mkArray @Int [2,3,4] [1]
+      let arr = mkArray @Int [2,3,4] [1..]
       getNumDims arr `shouldBe` 3
     it "Should get value of dims specified" $ do
       let arr = mkArray @Int [2,3,4,5] (repeat 1)

test/ArrayFire/LAPACKSpec.hs

@@ -11,7 +11,7 @@ spec =
     it "Should have LAPACK available" $ do
       A.isLAPACKAvailable `shouldBe` True
     it "Should perform svd" $ do
-      let (s,v,d) = A.svd $ A.matrix @Double (4,2) [[1..],[1..]]
+      let (s,v,d) = A.svd $ A.matrix @Double (4,2) [ [1,2], [3,4], [5,6], [7,8] ]
       A.getDims s `shouldBe` (4,4,1,1)
       A.getDims v `shouldBe` (2,1,1,1)
       A.getDims d `shouldBe` (2,2,1,1)

test/ArrayFire/SignalSpec.hs

@@ -13,7 +13,7 @@ spec :: Spec
 spec =
   describe "Signal spec" $ do
     it "Should do FFT in place" $ do
-      A.fftInPlace (A.matrix @(Complex Double) (10,10) [[1 :+ 1]]) 10.2
+      A.fftInPlace (A.matrix @(Complex Double) (1,1) [[1 :+ 1]]) 10.2
         `shouldReturn` ()
     it "Should do FFT" $ do
       A.fft (A.matrix @(Complex Float) (1,1) [[1 :+ 1]]) 1 1

test/Main.hs

@@ -1,7 +1,43 @@
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 module Main where
 
-import Spec       (spec)
-import Test.Hspec (hspec)
+import           Control.Monad
+
+import           Data.Proxy
+import           Spec                    (spec)
+import           Test.Hspec              (hspec)
+import           Test.QuickCheck
+import           Test.QuickCheck.Classes
+
+import qualified ArrayFire               as A
+import           ArrayFire               (Array)
+
+import           System.IO.Unsafe
+
+instance (A.AFType a, Arbitrary a) => Arbitrary (Array a) where
+  arbitrary = pure $ unsafePerformIO (A.randu [2,2])
 
 main :: IO ()
-main = hspec spec
+main = do
+--  checks (Proxy :: Proxy (A.Array (A.Complex Float)))
+--  checks (Proxy :: Proxy (A.Array (A.Complex Double)))
+--  checks (Proxy :: Proxy (A.Array Double))
+--  checks (Proxy :: Proxy (A.Array Float))
+--  checks (Proxy :: Proxy (A.Array Double))
+--  checks (Proxy :: Proxy (A.Array A.Int16))
+--  checks (Proxy :: Proxy (A.Array A.Int32))
+  -- checks (Proxy :: Proxy (A.Array A.CBool))
+  -- checks (Proxy :: Proxy (A.Array Word))
+  -- checks (Proxy :: Proxy (A.Array A.Word8))
+  -- checks (Proxy :: Proxy (A.Array A.Word16))
+  -- checks (Proxy :: Proxy (A.Array A.Word32))
+--  lawsCheck $ semigroupLaws (Proxy :: Proxy (A.Array Double))
+--  lawsCheck $ semigroupLaws (Proxy :: Proxy (A.Array Float))
+  hspec spec
+
+checks proxy = do
+  lawsCheck (numLaws proxy)
+  lawsCheck (eqLaws proxy)
+  lawsCheck (ordLaws proxy)
+--  lawsCheck (semigroupLaws proxy)