adding and fixing existing safe get-functions

Author: bbarker

Foreign/Matlab/Array.hsc

@@ -30,7 +30,8 @@ module Foreign.Matlab.Array (
     mxArrayGet, mxArraySet,
     -- | array list access
     mxArrayGetList, mxArraySetList,
-    mxArrayGetAll, mxArraySetAll, mxArrayGetFirst,
+    mxArrayGetAll, mxArraySetAll,
+    mxArrayGetSafe, mxArrayGetFirst, mxArrayGetLast,
     fromListIO, cellFromListsIO,
     isMNull,
 
@@ -127,7 +128,9 @@ copyMXArray a = withMXArray a mxDuplicateArray >>= mkMXArray
 foreign import ccall unsafe mxDestroyArray :: MXArrayPtr -> IO ()
 -- |Destroy an array and all of its contents.
 freeMXArray :: MXArray a -> MIO ()
-freeMXArray a = withMXArray a mxDestroyArray
+freeMXArray a = do
+  withMXArray a mxDestroyArray
+  mxArraySetSize a [0, 0]
 
 -- | Create and populate an MXArray in one go. Named without 'mx' due to possible
 -- | conformity to a typeclass function.
@@ -228,9 +231,26 @@ mxArraySetAll :: MXArrayComponent a => MXArray a -> [a] -> IO ()
 mxArraySetAll a = mxArraySetList a mStart
 
 mxArrayGetFirst :: MXArrayComponent a => MXArray a -> MIO (Either String a)
-mxArrayGetFirst arr
-  | isMNull arr = pure $ Left "Couldn't get first element of null array"
-  | otherwise = Right <$> mxArrayGetOffset arr 0
+mxArrayGetFirst arr = mxArrayGetSafe arr 0
+
+mxArrayGetLast :: MXArrayComponent a => MXArray a -> MIO (Either String a)
+mxArrayGetLast arr = do
+  arrLen <- mxArrayLength arr
+  mxArrayGetSafe arr (arrLen - 1)
+
+-- |Like mxArrayGetOffset but safe.
+mxArrayGetSafe :: forall a. MXArrayComponent a => MXArray a -> Int -> MIO (Either String a)
+mxArrayGetSafe arr ix
+  | isMNull arr = pure $ Left "Couldn't get element of null array"
+  | otherwise = do
+    arrLen <- mxArrayLength arr
+    safeGetElem arrLen ix
+  where
+    safeGetElem :: Int -> Int -> MIO (Either String a)
+    safeGetElem aLen aIx
+      | aIx < aLen = Right <$> mxArrayGetOffset arr aIx
+      | otherwise = pure $ Left $ "Couldn't get element at index "
+        <> (show aIx) <> " of " <> (show aLen) <> "-length array"
 
 -- |Safely cast a generic array to a type, or return Nothing if the array does not have the proper type
 castMXArray :: forall a. MXArrayComponent a => MAnyArray -> MIO (Maybe (MXArray a))

test/Test/Engine.hs

@@ -26,7 +26,7 @@ runEngineTests host = do
   runLocalMatFun eng
   cosOfPi eng
   testIsMNull eng
-  testGetFirst eng
+  testGetFirstLast eng
   testAbstractValueUse eng
   testTypedAbstractValueUse eng
   testGetByteStreamFromArray eng
@@ -60,23 +60,32 @@ testIsMNull eng = do
   xa <- createMXScalar (1.0 :: MDouble)
   let xaRes = assert (isMNull xa == False) xa
   xaResEi <- mxArrayGetFirst xaRes
-  putStrLn $ "  xaResEi is Right: " <> (show $ isRight xaResEi)
+  putStrLn $ "  xaResEi is Right: " <> (show xaResEi)
   xae :: MXArray MChar <- createMXArray []
   freeMXArray xae
   mxLen <- mxArrayLength xae
-  putStrLn $ "length is " <> (show mxLen)
-  -- This is a bit surprising, but ok
+  mxDims <- mxArraySize xae
+  putStrLn $ "length is " <> (show mxLen) <> " dims are " <> (show $ mxDims)
   let xaeRes = assert (isMNull xae == False) xae
   xaeResEi <- mxArrayGetFirst xaeRes
-  putStrLn $ "  xaeResEi is Right: " <> (show $ isRight xaeResEi)
-
-testGetFirst :: Engine -> IO ()
-testGetFirst eng = do
-  putStrLn $ "\n-- testGetFirst --"
-  xa <- createMXScalar (1.0 :: MDouble)
-  xEi <- mxArrayGetFirst xa
-  let xRes = assert (xEi == Right 1.0) xEi
+  putStrLn $ "  xaeResEi is Left: " <> (show xaeResEi)
+
+testGetFirstLast :: Engine -> IO ()
+testGetFirstLast eng = do
+  putStrLn $ "\n-- testGetFirstLast --"
+  let testVal :: MDouble = 1.0
+  xa <- createMXScalar testVal
+  xfEi <- mxArrayGetFirst xa
+  xlEi <- mxArrayGetLast xa
+  let xRes = assert (xlEi == Right 1.0 && xfEi == xlEi) xfEi
   putStrLn $ "  xRes is : " <> (show xRes)
+  threeArray :: MXArray MDouble <- fromListIO [5.0, 6.0, 7.0]
+  txfEi <- mxArrayGetFirst threeArray
+  txlEi <- mxArrayGetLast threeArray
+  let txfRes = assert (txfEi == Right 5.0) txfEi
+  putStrLn $ "  txfRes is : " <> (show txfRes)
+  let txlRes = assert (txlEi == Right 7.0) txlEi
+  putStrLn $ "  txlRes is : " <> (show txlRes)
 
 testAbstractValueUse :: Engine -> IO ()
 testAbstractValueUse eng = do