Update haddocks, cabal file, add tests

Author: dmjio

arrayfire.cabal

@@ -15,8 +15,6 @@ description:         High-level Haskell bindings to the ArrayFire General-purpos
     .
     <<https://user-images.githubusercontent.com/875324/59819388-9ff83f00-92f5-11e9-9ac0-51eef200c716.png>>
     .
-    <https://www.youtube.com/watch?v=tI89V1Z8QHw>
-    .
 
 library
   exposed-modules:

src/ArrayFire/Algorithm.hs

@@ -104,6 +104,7 @@ anyTrue
   -- ^ Returns if all elements are true
 anyTrue x (fromIntegral -> n) = getScalar @Bool @a (x `op1` (\p a -> af_any_true p a n))
 
+-- | Retrieves count of all elements in 'Array' along the specified dimension
 count
   :: forall a . AFType a
   => Array a
@@ -114,7 +115,8 @@ count
   -- ^ Count of all elements along dimension
 count x (fromIntegral -> n) = getScalar @Int @a (x `op1` (\p a -> af_count p a n))
 
--- | Note: imag is always set to 0 when in is real
+-- | Sum all elements in 'Array'
+-- Note: imag is always set to 0 when in is real
 sumAll
   :: AFType a
   => Array a
@@ -123,6 +125,7 @@ sumAll
   -- ^ imaginary and real part
 sumAll = (`infoFromArray2` af_sum_all)
 
+-- | Sum all elements in 'Array', substituting 'NaN' values with a user specified default.
 sumNaNAll
   :: (AFType a, Fractional a)
   => Array a
@@ -133,6 +136,7 @@ sumNaNAll
   -- ^ imaginary and real part
 sumNaNAll a d = infoFromArray2 a (\p g x -> af_sum_nan_all p g x d)
 
+-- | Product all elements in 'Array'
 productAll
   :: AFType a
   => Array a
@@ -141,6 +145,7 @@ productAll
   -- ^ imaginary and real part
 productAll = (`infoFromArray2` af_product_all)
 
+-- | Product all elements in 'Array', substituting NaN values with a user specified default.
 productNaNAll
   :: (AFType a, Fractional a)
   => Array a
@@ -151,6 +156,7 @@ productNaNAll
   -- ^ imaginary and real part
 productNaNAll a d = infoFromArray2 a (\p x y -> af_product_nan_all p x y d)
 
+-- | Finds the minimum value of all elements in the Array
 minAll
   :: AFType a
   => Array a

src/ArrayFire/BLAS.hs

@@ -3,13 +3,31 @@
 -- |
 -- Module      : ArrayFire.BLAS
 -- Copyright   : David Johnson (c) 2019-2020
--- License     : BSD 3
+-- License     : BSD3
 -- Maintainer  : David Johnson <[email protected]>
 -- Stability   : Experimental
 -- Portability : GHC
 --
 -- Basic Linear Algebra Subprograms (BLAS) API
 --
+-- @
+-- main :: IO ()
+-- main = 'print' ('matmul' x y xProp yProp)
+--  where
+--     x,y :: 'Array' 'Double'
+--     x = 'matrix' (2,3) [1..]
+--     y = 'matrix' (3,2) [1..]
+--
+--     xProp, yProp :: 'MatProp'
+--     xProp = None
+--     yProp = None
+-- @
+-- @
+-- ArrayFire Array
+-- [2 2 1 1]
+--   22.0000    28.0000
+--   49.0000    64.0000
+-- @
 --------------------------------------------------------------------------------
 module ArrayFire.BLAS where
 
@@ -30,7 +48,6 @@ import ArrayFire.Types
 -- optLhs an only be one of AF_MAT_NONE, AF_MAT_TRANS, AF_MAT_CTRANS.
 --
 -- optRhs can only be AF_MAT_NONE.
---
 matmul
   :: Array a
   -- ^ 2D matrix of Array a, left-hand side

src/ArrayFire/Backend.hs

@@ -7,6 +7,21 @@
 -- Stability   : Experimental
 -- Portability : GHC
 --
+-- Set and get available ArrayFire 'Backend's.
+--
+-- @
+-- module Main where
+--
+-- import ArrayFire
+--
+-- main :: IO ()
+-- main = print =<< getAvailableBackends
+-- @
+--
+-- @
+-- [nix-shell:~\/arrayfire]$ .\/main
+-- [CPU,OpenCL]
+-- @
 --------------------------------------------------------------------------------
 module ArrayFire.Backend where
 

src/ArrayFire/Device.hs

@@ -10,6 +10,12 @@
 --
 -- Information about ArrayFire API and devices
 --
+-- @
+--  ArrayFire v3.6.4 (OpenCL, 64-bit Mac OSX, build 1b8030c5)
+-- [0] APPLE: AMD Radeon Pro 555X Compute Engine, 4096 MB
+-- -1- APPLE: Intel(R) UHD Graphics 630, 1536 MB
+-- @
+--
 --------------------------------------------------------------------------------
 module ArrayFire.Device where
 
@@ -18,15 +24,6 @@ import ArrayFire.Internal.Device
 import ArrayFire.FFI
 
 -- | Retrieve info from ArrayFire API
---
--- Example below:
---
--- @
---
---  ArrayFire v3.6.4 (OpenCL, 64-bit Mac OSX, build 1b8030c5)
--- [0] APPLE: AMD Radeon Pro 555X Compute Engine, 4096 MB
--- -1- APPLE: Intel(R) UHD Graphics 630, 1536 MB
--- @
 info :: IO ()
 info = afCall af_info
 
@@ -45,7 +42,6 @@ getDeviceCount :: IO Int
 getDeviceCount = fromIntegral <$> afCall1 af_get_device_count
 
 -- af_err af_get_dbl_support(bool* available, const int device);
-
 -- | Sets a device by 'Int'
 setDevice :: Int -> IO ()
 setDevice (fromIntegral -> x) = afCall (af_set_device x)

src/ArrayFire/FFI.hs

@@ -17,6 +17,8 @@ import ArrayFire.Exception
 import ArrayFire.Types
 import ArrayFire.Internal.Defines
 import ArrayFire.Internal.Features
+import ArrayFire.Internal.Array
+
 import Control.Exception
 import Control.Monad
 import Foreign.ForeignPtr
@@ -325,8 +327,10 @@ featuresToArray (Features fptr1) op =
     withForeignPtr fptr1 $ \ptr1 -> do
       alloca $ \ptrInput -> do
         throwAFError =<< op ptrInput ptr1
-        Array <$> do
-          newForeignPtr_ =<< peek ptrInput
+        alloca $ \retainedArray -> do
+          throwAFError =<< af_retain_array retainedArray =<< peek ptrInput
+          fptr <- newForeignPtr af_release_array_finalizer =<< peek retainedArray
+          pure (Array fptr)
 
 infoFromFeatures
   :: Storable a

src/ArrayFire/LAPACK.hs

@@ -35,6 +35,7 @@ svd
   -- 'vt' is the output array containing V^H
 svd = (`op3p` af_svd)
 
+
 svdInPlace
   :: AFType a
   => Array a
@@ -74,7 +75,7 @@ cholesky
 cholesky a (fromIntegral . fromEnum -> b) = do
   let (x',y') = op1b a (\x y z -> af_cholesky x y z b)
   (fromIntegral x', y')
-  
+
 choleskyInplace
   :: AFType a
   => Array a
@@ -110,6 +111,7 @@ inverse
 inverse a m =
   a `op1` (\x y  -> af_inverse x y (toMatProp m))
 
+-- | Not implemented in 3.6.4
 pinverse
   :: AFType a
   => Array a

src/ArrayFire/Orphans.hs

@@ -21,6 +21,7 @@ import           Prelude
 
 import qualified ArrayFire.Arith    as A
 import qualified ArrayFire.Array    as A
+import qualified ArrayFire.Data     as A
 import           ArrayFire.Types
 import           ArrayFire.Util
 
@@ -33,7 +34,9 @@ instance (Num a, AFType a) => Num (Array a) where
   x * y       = A.mul x y False
   abs         = A.abs
   signum      = A.sign
-  negate      = error "TODO: negate"
+  negate arr  = do
+    let (w,x,y,z) = A.getDims arr
+    A.cast (A.constant [w,x,y,z] 0.0) `A.sub` arr $ False
   x - y       = A.sub x y False
   fromInteger = A.scalar . fromIntegral
 

src/ArrayFire/Random.hs

@@ -12,11 +12,45 @@
 -- |
 -- Module      : ArrayFire.Random
 -- Copyright   : David Johnson (c) 2019-2020
--- License     : BSD 3
+-- License     : BSD3
 -- Maintainer  : David Johnson <[email protected]>
 -- Stability   : Experimental
 -- Portability : GHC
 --
+-- 'RandomEngine' generation, Random 'Array' generation.
+--
+-- @
+-- {-\# LANGUAGE TypeApplications \#-}
+-- module Main where
+--
+-- import 'ArrayFire'
+--
+-- main :: IO ()
+-- main = do
+--   seed <- 'getSeed'
+--   -- ^ Retrieves seed
+--   engine <- 'createRandomEngine' 'Mersenne' seed
+--   -- ^ Creates engine
+--   array <- 'randomUniform' [3,3] engine
+--   -- ^ Creates random Array from engine with uniformly distributed data
+--   print array
+--
+--   print =<< 'randu' @'Double' [2,2]
+--   -- ^ Shorthand for creating random 'Array'
+-- @
+-- @
+-- ArrayFire 'Array'
+-- [3 3 1 1]
+--    0.4446     0.1143     0.4283
+--    0.5725     0.1456     0.9182
+--    0.1915     0.1643     0.5997
+-- @
+-- @
+-- ArrayFire 'Array'
+-- [2 2 1 1]
+--    0.6010     0.0278
+--    0.9806     0.2126
+-- @
 --------------------------------------------------------------------------------
 module ArrayFire.Random
   ( createRandomEngine

test/ArrayFire/AlgorithmSpec.hs

@@ -97,3 +97,18 @@ spec =
       A.count (A.vector @A.CBool 5 (repeat 1)) 0 `shouldBe` 5
       A.count (A.vector @Double 5 (repeat 1)) 0 `shouldBe` 5
       A.count (A.vector @Float 5 (repeat 1)) 0 `shouldBe` 5
+    it "Should get sum all elements" $ do
+      A.sumAll (A.vector @Int 5 (repeat 2)) `shouldBe` (10,0)
+      A.sumAll (A.vector @Double 5 (repeat 2)) `shouldBe` (10.0,0)
+      A.sumAll (A.vector @(A.Complex Double) 5 (repeat (2 A.:+ 0))) `shouldBe` (10.0,0)
+    it "Should get sum all elements" $ do
+      A.sumNaNAll (A.vector @Double 2 [10, acos 2]) 1 `shouldBe` (11.0,0)
+    it "Should product all elements in an Array" $ do
+      A.productAll (A.vector @Int 5 (repeat 2)) `shouldBe` (32,0)
+    it "Should product all elements in an Array" $ do
+      A.productNaNAll (A.vector @Double 2 [10,acos 2]) 10 `shouldBe` (100,0)
+    it "Should find minimum value of an Array" $ do
+      A.minAll (A.vector @Int 5 [0..]) `shouldBe` (0,0)
+    it "Should find maximum value of an Array" $ do
+      A.maxAll (A.vector @Int 5 [0..]) `shouldBe` (4,0)
+

test/ArrayFire/ArithSpec.hs

@@ -9,6 +9,10 @@ import Foreign.C
 spec :: Spec
 spec =
   describe "Arith tests" $ do
+    it "Should negate scalar value" $ do
+      negate (scalar @Int 1) `shouldBe` (-1)
+    it "Should negate a vector" $ do
+      negate (vector @Int 3 [2,2,2]) `shouldBe` vector @Int 3 [-2,-2,-2]
     it "Should add two scalar arrays" $ do
       scalar @Int 1 + 2 `shouldBe` 3
     it "Should add two scalar bool arrays" $ do

test/ArrayFire/FeaturesSpec.hs

@@ -1,7 +1,8 @@
 {-# LANGUAGE TypeApplications #-}
 module ArrayFire.FeaturesSpec where
 
-import ArrayFire
+import ArrayFire hiding (acos)
+import Prelude
 import Test.Hspec
 
 spec :: Spec
@@ -10,8 +11,8 @@ spec =
     it "Should get features number an array" $ do
       let feats = createFeatures 10
       getFeaturesNum feats `shouldBe` 10
-      -- print (getFeaturesSize feats)
-      -- print (getFeaturesOrientation feats)
-      -- print (getFeaturesXPos feats)
-      -- print (getFeaturesYPos feats)
-
+      -- let vec = vector @Double 10 $ repeat (acos 2)
+      -- getFeaturesSize feats `shouldBe` vec
+      -- getFeaturesOrientation feats `shouldBe` vec
+      -- getFeaturesXPos feats `shouldBe` vec
+      -- getFeaturesYPos feats `shouldBe` vec

test/ArrayFire/LAPACKSpec.hs

@@ -39,6 +39,6 @@ spec =
     it "Should calculate inverse" $ do
       let x = flip A.inverse A.None $ A.matrix @Double (2,2) [4,7,2,6]
       x `shouldBe` A.matrix @Double (2,2) [0.6,-0.2,-0.7,0.4]
-    -- it "Should calculate psuedo inverse" $ do
-    --   let x = A.pinverse (A.matrix @Double (2,2) [4,7,2,6]) 1.0 A.None
-    --   x `shouldBe` A.matrix @Double (2,2) [0.6,-0.2,-0.7,0.4]
+  -- it "Should calculate psuedo inverse" $ do
+  --   let x = A.pinverse (A.matrix @Double (2,2) [4,7,2,6]) 1.0 A.None
+  --   x `shouldBe` A.matrix @Double (2,2) [0.6,-0.2,-0.7,0.4]