Adding a few convenience functions and tests (bmsherman#13)

* exporting MType

* adding untyped abstract value usage

* added demonstration of abstract type usage to tests

* added serialization functions and tests; added (untested) clearVar

* started adding some cell array tests

* added some convenience functions for extracting data from cell arrays, and an associated engine test

* Revert "exporting MType"

This reverts commit 6931edb.

Author: bbarker

Diff for: .gitignore

@@ -1,2 +1,5 @@
 .stack-work
 patchMatlab.lock
+
+# Editor files
+*~

Diff for: Foreign/Matlab/Array.hsc

@@ -41,6 +41,7 @@ module Foreign.Matlab.Array (
     mStructGet, mStructSet,
     mStructSetFields,
     mStructAddField, mStructRemoveField,
+    mxCellGetAllOfType, mxCellGetArraysOfType,
 
     -- ** Object access
     -- |Some structs are also validated (blessed) user objects.
@@ -52,6 +53,7 @@ import Foreign
 import Foreign.C.String
 import Foreign.C.Types
 import Data.Complex
+import Data.Maybe (catMaybes)
 import Foreign.Matlab.Util
 import Foreign.Matlab.Internal
 import Foreign.Matlab.Types
@@ -103,6 +105,7 @@ mxArraySetSize a s = do
   when (r /= 0) $ fail "mxArraySetSize"
 
 foreign import ccall unsafe mxGetNumberOfElements :: MXArrayPtr -> IO CSize
+-- |Like `numel` in MATLAB.
 mxArrayLength :: MXArray a -> MIO Int
 mxArrayLength a = ii =.< withMXArray a mxGetNumberOfElements
 
@@ -212,6 +215,20 @@ castMXArray a
         b :: MXArray a
         b = unsafeCastMXArray a
 
+-- | Extract all arrays of a given type from a Cell Array.
+mxCellGetArraysOfType :: MXArrayComponent a => MXArray MCell -> MIO ([MXArray a])
+mxCellGetArraysOfType ca = do
+  cellVals <- (fmap . fmap) mCell (mxArrayGetAll ca)
+  mxaMays :: [Maybe (MXArray a)] <- sequence $ castMXArray <$> cellVals
+  pure $ catMaybes mxaMays
+
+-- | A convenience function to extract all arrays of a given type from a Cell Array;
+-- | may have larger dimensions than the original Cell Array due to flattening.
+mxCellGetAllOfType :: MXArrayComponent a => MXArray MCell -> MIO [a]
+mxCellGetAllOfType ca = do
+  as <- mxCellGetArraysOfType ca
+  join <$> (sequence $ mxArrayGetAll <$> as)
+
 foreign import ccall unsafe mxGetData :: MXArrayPtr -> IO (Ptr a)
 
 class (MXArrayComponent a, MType mx a, Storable mx) => MXArrayData mx a where

Diff for: Foreign/Matlab/Engine.hsc

@@ -71,8 +71,8 @@ data EngineEvalArg a = EvalArray (MXArray a) | EvalVar String | EvalStr String
 -- |Evaluate a function with the given arguments and number of results.
 -- This automates 'engineSetVar' on arguments (using \"hseval_inN\"), 'engineEval', and 'engineGetVar' on results (using \"hseval_outN\").
 engineEvalFun :: Engine -> String -> [EngineEvalArg a] -> Int -> IO [MAnyArray]
-engineEvalFun eng fun arg no = do
-  arg <- zipWithM makearg arg [1 :: Int ..]
+engineEvalFun eng fun args no = do
+  arg <- zipWithM makearg args [1 :: Int ..]
   let out = map makeout [1..no]
   let outs = if out == [] then "" else "[" ++ unwords out ++ "] = "
   engineEval eng (outs ++ fun ++ "(" ++ intercalate "," arg ++ ")")
@@ -88,8 +88,8 @@ engineEvalFun eng fun arg no = do
 
 -- |Convenience function for calling functions that do not return values (i.e. "procedures").
 engineEvalProc :: Engine -> String -> [EngineEvalArg a] -> IO ()
-engineEvalProc eng fun arg = do
-  _ <- engineEvalFun eng fun arg 0
+engineEvalProc eng fun args = do
+  _ <- engineEvalFun eng fun args 0
   pure ()
 
 -- |Utility function to quote a string

Diff for: Foreign/Matlab/Engine/Wrappers.hs

@@ -1,19 +1,57 @@
 {-|
- Wrappers to common MATLAB functions using the Matlab engine.
+ Wrappers to common (and some uncommon) MATLAB functions using the MATLAB Engine.
 
  Note that you cannot use "Foreign.Matlab.Engine" and "Foreign.Matlab.Runtime" in the same program.
  This seems to be a Matlab limitation.
  -}
 
 module Foreign.Matlab.Engine.Wrappers (
-         addpath
-       ) where
+  addpath
+, clearVar
+, getArrayFromByteStream
+, getByteStreamFromArray
+, MEither(..), isMLeft, isMRight
+) where
 
+import Foreign.Matlab
 import Foreign.Matlab.Engine
 import Path
 
 -- | We require an absolute path in this case
 addpath :: Engine -> Path Abs Dir -> IO ()
-addpath eng p = do
-  engineEvalProc eng "addpath" [EvalStr $ toFilePath p]
-  -- engineEval eng $ "addpath(" <> toFilePath p <> "');"
+addpath eng p = engineEvalProc eng "addpath" [EvalStr $ toFilePath p]
+
+-- | TODO: add a test for this, likely not working as expected.
+-- | Clears a variable from the engine's workspace
+clearVar :: Engine -> String -> IO ()
+clearVar eng var = engineEvalProc eng "clear" [EvalStr var]
+
+-- | Wraps an undocumented function to serialize a MATLAB object.
+getByteStreamFromArray :: Engine -> MAnyArray -> IO (Either String [MUint8])
+getByteStreamFromArray eng mObj = do
+  [byteStream] <- engineEvalFun eng "getByteStreamFromArray" [EvalArray mObj] 1
+  mxArrMay <- castMXArray byteStream
+  case mxArrMay of
+    Just mxArr -> Right <$> mxArrayGetAll mxArr
+    Nothing -> pure $ Left
+      "getByteStreamFromArray: Couldn't convert MATLAB bytestream to [MUint8]"
+
+-- | Wraps an undocumented function to deserialize a MATLAB object.
+getArrayFromByteStream :: Engine -> [MUint8] -> IO MAnyArray
+getArrayFromByteStream eng bytes = do
+  matBsArr <- createMXArray [length bytes]
+  mxArraySetAll matBsArr bytes
+  [mObj] <- engineEvalFun eng "getArrayFromByteStream" [EvalArray matBsArr] 1
+  pure mObj
+
+newtype MEither = MEither {unMXEither :: MStructArray}
+
+isMLeft :: MEither -> IO Bool
+isMLeft me = do
+  sFields <- mStructFields $ unMXEither me
+  pure $ "left" `elem` sFields
+
+isMRight :: MEither -> IO Bool
+isMRight me = do
+  sFields <- mStructFields $ unMXEither me
+  pure $ "right" `elem` sFields

Diff for: matlab.cabal

@@ -103,7 +103,7 @@ executable matlab-engine-test
       Test.UtilTemplate
   hs-source-dirs:
       test
-  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N -fno-ignore-asserts
   build-depends:
       base >= 4 && <5
     , exceptions

Diff for: test/Test/Engine.hs

@@ -1,11 +1,14 @@
 {-# LANGUAGE QuasiQuotes            #-}
+{-# LANGUAGE ScopedTypeVariables    #-}
 {-# LANGUAGE TemplateHaskell        #-}
 
 module Test.Engine where
 
+import Control.Exception (SomeException, assert, try)
+import Data.Either (isLeft, isRight, lefts)
 import Foreign.Matlab
 import Foreign.Matlab.Engine
-import Foreign.Matlab.Engine.Wrappers (addpath)
+import Foreign.Matlab.Engine.Wrappers
 import Language.Haskell.TH (Q, runIO)
 import Language.Haskell.TH.Syntax (lift)
 import Path
@@ -15,11 +18,19 @@ engineTests = runEngineTests ""
 
 runEngineTests :: String -> IO ()
 runEngineTests host = do
-  putStrLn " -- Starting engine --"
+  putStrLn "-- Starting engine --"
   eng <- newEngine host
-  putStrLn " -- Engine created --"
+  putStrLn "-- Engine created --"
+  let testPath = repoDir </> testRel
+  addpath eng testPath
   runLocalMatFun eng
   cosOfPi eng
+  testAbstractValueUse eng
+  testTypedAbstractValueUse eng
+  testGetByteStreamFromArray eng
+  testGetArrayFromByteStream eng
+  testCellGet eng
+  testClearVar eng
 
 cosOfPi :: Engine -> IO ()
 cosOfPi eng = do
@@ -30,12 +41,7 @@ cosOfPi eng = do
 runLocalMatFun :: Engine -> IO ()
 runLocalMatFun eng = do
   putStrLn "\n-- mtest: cos pi --"
-  let testPath = repoDir </> testRel
   x <- createMXScalar (pi :: MDouble)
-  addpath eng testPath
-  -- let addTestPath = "addpath " <> (toFilePath testPath)
-  -- putStrLn $ "evaluating: " <> addTestPath
-  -- engineEval eng addTestPath
   cosBody eng "mtest" x
 
 cosBody :: Engine -> String -> MXArray MDouble -> IO ()
@@ -46,6 +52,105 @@ cosBody eng cosFun x = do
   y <- mxScalarGet y
   print (y :: MDouble)
 
+testAbstractValueUse :: Engine -> IO ()
+testAbstractValueUse eng = do
+  putStrLn $ "\n-- testAbstractValueUse --"
+  sOut <- makeTestStruct eng
+  sSum <- useTestStruct eng sOut
+  let sSumRes = assert (sSum == 7.0) sSum
+  putStrLn $ "  struct sum is: " <> (show sSumRes)
+
+makeTestStruct :: Engine -> IO MAnyArray
+makeTestStruct eng = do
+  [res] <- engineEvalFun eng "makeTestStruct" [] 1
+  pure res
+
+useTestStruct :: Engine -> MAnyArray -> IO MDouble
+useTestStruct eng sIn = do
+  [res] <- engineEvalFun eng "useTestStruct" [EvalArray sIn] 1
+  mxArrMay <- castMXArray res
+  case mxArrMay of
+    Just mxArr -> mxScalarGet mxArr
+    Nothing -> pure 0.0
+
+
+newtype MyAbsType = MyAbsType { unMyAbsType :: MAnyArray }
+
+-- |Similar to testAbstractValueUse, but instead of using
+-- |MAnyArray, we use newtypes for better type safety
+testTypedAbstractValueUse :: Engine -> IO ()
+testTypedAbstractValueUse eng = do
+  putStrLn $ "\n-- testTypedAbstractValueUse --"
+  sOut <- makeTestStructTyped eng
+  sSum <- useTestStructTyped eng sOut
+  let sSumRes = assert (sSum == 7.0) sSum
+  putStrLn $ "  struct sum is: " <> (show sSumRes)
+
+makeTestStructTyped :: Engine -> IO MyAbsType
+makeTestStructTyped eng = MyAbsType <$> (makeTestStruct eng)
+
+useTestStructTyped :: Engine -> MyAbsType -> IO MDouble
+useTestStructTyped eng (MyAbsType sIn) = useTestStruct eng sIn
+
+testGetByteStreamFromArray :: Engine -> IO ()
+testGetByteStreamFromArray eng = do
+  putStrLn $ "\n-- testGetByteStreamFromArray --"
+  sOutBSMatlab <- makeTestStructByteStream eng
+  sOut <- makeTestStruct eng
+  Right sOutBSHaskell <- getByteStreamFromArray eng sOut
+  let bsSum = sum $ fromIntegral <$> (assert (sOutBSMatlab == sOutBSHaskell) sOutBSHaskell)
+  putStrLn $ " bytestream sum is: " <> (show bsSum)
+
+testGetArrayFromByteStream :: Engine -> IO ()
+testGetArrayFromByteStream eng = do
+  putStrLn $ "\n-- testGetArrayFromByteStream --"
+  sOutBS <- makeTestStructByteStream eng
+  sOutFromBS <- getArrayFromByteStream eng sOutBS
+  sOut <- makeTestStruct eng
+  sSumFromBS <- useTestStruct eng sOutFromBS
+  sSum <- useTestStruct eng sOut
+  let sSumRes = assert (sSumFromBS == sSum) sSumFromBS
+  putStrLn $ " deserialized struct sum is: " <> (show sSumRes)
+
+makeTestStructByteStream :: Engine -> IO [MUint8]
+makeTestStructByteStream eng = do
+  [res] <- engineEvalFun eng "makeTestStructByteStream" [] 1
+  mxArrMay <- castMXArray res
+  case mxArrMay of
+    Just mxArr -> mxArrayGetAll mxArr
+    Nothing -> pure []
+
+-- TODO: display cell array and extracted values in test
+testCellGet :: Engine -> IO ()
+testCellGet eng = do
+  putStrLn "\n-- testCellGet --"
+  [ca] <- engineEvalFun eng "mcellTest" [] 1
+  Just (ca :: MXArray MCell) <- castMXArray ca
+  caLen <- mxArrayLength ca
+  let caLenMsg = assert (caLen == 6) "cell array has length 6"
+  putStrLn caLenMsg
+  dCells :: [MXArray MDouble] <- mxCellGetArraysOfType ca
+  let dCellsMsg = assert (length dCells == 4) "cell array has 4 double arrays"
+  putStrLn dCellsMsg
+  dVals :: [MDouble] <- mxCellGetAllOfType ca
+  let dValsMsg = assert (length dVals == 4) "cell array has 4 double values"
+  putStrLn dValsMsg
+
+testClearVar :: Engine -> IO ()
+testClearVar eng = do
+  putStrLn $ "\n-- testClearVar --"
+  let foopi = "foopi"
+  x <- createMXScalar (pi :: MDouble)
+  engineSetVar eng foopi x
+  ei1 :: Either SomeException MAnyArray <- try $ engineGetVar eng foopi
+  putStrLn $ assert (isRight ei1) "  Can clearVar once"
+  clearVar eng foopi
+  ei2 :: Either SomeException MAnyArray <- try $ engineGetVar eng foopi
+  putStrLn $ assert (isLeft ei2) $
+    " Can't clearVar twice: " <> (show $ lefts [ei2])
+  putStrLn "  Finished testClearVar"
+
+
 testRel :: Path Rel Dir
 testRel = $(mkRelDir "test")
 

Diff for: test/makeTestStruct.m

@@ -0,0 +1,3 @@
+function sOut = makeTestStruct()
+  sOut = struct('x', 2, 'y', 5);
+end

Diff for: test/makeTestStructByteStream.m

@@ -0,0 +1,4 @@
+function sOutBS = makeTestStructByteStream()
+  sOut = makeTestStruct();
+  sOutBS = getByteStreamFromArray(sOut);
+end

Diff for: test/mcellTest.m

@@ -0,0 +1,2 @@
+function y = mcellTest(x)
+y = {'ads', '123', 4; 7 8 9};

Diff for: test/useTestStruct.m

@@ -0,0 +1,3 @@
+function sumOut = useTestStruct(sIn)
+  sumOut = sIn.x + sIn.y;
+end