hruby 0.3.7 → 0.3.8

raw patch · 8 files changed

+75/−35 lines, 8 files

Files

• Foreign/Ruby.hs +1/−0
• Foreign/Ruby/Bindings.hsc +6/−7
• Foreign/Ruby/Helpers.hs +41/−17
• Foreign/Ruby/Safe.hs +15/−1
• cbits/shim.c +6/−6
• cbits/shim.h +2/−2
• hruby.cabal +1/−1
• test/roundtrip.hs +3/−1

@@ -14,6 +14,7 @@   , loadFile   , Foreign.Ruby.Safe.embedHaskellValue   , Foreign.Ruby.Safe.safeMethodCall+  , Foreign.Ruby.Safe.safeFunCall   , makeSafe   , RubyError(..)   -- * Converting to and from Ruby values

@@ -14,18 +14,16 @@ -- | The Ruby ID type, mostly used for symbols. type RID = CULong -data ShimDispatch = ShimDispatch String String [RValue]+data ShimDispatch = ShimDispatch RValue RID [RValue] instance Storable ShimDispatch where     sizeOf _ = (#size struct s_dispatch)     alignment = sizeOf-    peek ptr = do a <- peekCString ((#ptr struct s_dispatch, classname) ptr)-                  b <- peekCString ((#ptr struct s_dispatch, methodname) ptr)+    peek ptr = do a <- peek ((#ptr struct s_dispatch, receiver) ptr)+                  b <- peek ((#ptr struct s_dispatch, methodid) ptr)                   return (ShimDispatch a b [])     poke ptr (ShimDispatch c m vals) = do-        cs <- newCString c-        cm <- newCString m-        (#poke struct s_dispatch, classname) ptr cs-        (#poke struct s_dispatch, methodname) ptr cm+        (#poke struct s_dispatch, receiver) ptr c+        (#poke struct s_dispatch, methodid) ptr m         (#poke struct s_dispatch, nbargs) ptr (length vals)         let arrayblock = (#ptr struct s_dispatch, args) ptr         pokeArray arrayblock vals@@ -113,6 +111,7 @@ foreign import ccall   safe "rb_define_global_function" c_rb_define_global_function :: CString -> FunPtr a -> Int -> IO () foreign import ccall unsafe "rb_const_get"              rb_const_get                :: RValue -> RID -> IO RValue foreign import ccall   safe "&safeCall"                 safeCallback                :: FunPtr (RValue -> IO RValue)+foreign import ccall   safe "&getRubyCObject"           getRubyCObjectCallback      :: FunPtr (RValue -> IO RValue) foreign import ccall   safe "rb_protect"                c_rb_protect                :: FunPtr (RValue -> IO RValue) -> RValue -> Ptr Int -> IO RValue foreign import ccall unsafe "rb_string_value_cstr"      c_rb_string_value_cstr      :: Ptr RValue -> IO CString foreign import ccall unsafe "rb_ary_new"                rb_ary_new                  :: IO RValue

@@ -4,6 +4,7 @@ import Foreign.Ruby.Bindings  import Foreign+import Foreign.C (withCString) import Data.Aeson import Control.Monad import qualified Data.Text as T@@ -190,26 +191,49 @@ defineGlobalClass :: String -> IO RValue defineGlobalClass s = peek rb_cObject >>= rb_define_class s --- | Runs a Ruby method, capturing errors.-safeMethodCall :: String -- ^ Class name.+-- | Gets a Ruby class, capturing errors.+safeGetClass :: String -> IO (Either (String, RValue) RValue)+safeGetClass s =+  withCString s $ \cs ->+  with 0 $ \pstatus -> do+    o <- c_rb_protect getRubyCObjectCallback (castPtr cs) pstatus+    status <- peek pstatus+    if status == 0+      then pure $ Right o+      else do+        err <- showErrorStack+        pure $ Left (err, o)++-- | Runs a Ruby singleton method, capturing errors.+safeMethodCall :: String -- ^ Name of a class or a module.                -> String -- ^ Method name.                -> [RValue] -- ^ Arguments. Please note that the maximum number of arguments is 16.                -> IO (Either (String, RValue) RValue) -- ^ Returns either an error message / value couple, or the value returned by the function.-safeMethodCall classname methodname args =-    if length args > 16-        then return (Left ("too many arguments", rbNil))-        else do-            dispatch <- new (ShimDispatch classname methodname args)-            pstatus <- new 0-            o <- c_rb_protect safeCallback (castPtr dispatch) pstatus-            status <- peek pstatus-            free dispatch-            free pstatus-            if status == 0-                then return (Right o)-                else do-                    err <- showErrorStack-                    return (Left (err,o))+safeMethodCall classname methodname args = do+  erecv <- safeGetClass classname+  case erecv of+    Right recv -> safeFunCall recv methodname args+    Left err -> pure $ Left err++-- | Runs a Ruby method, capturing errors.+safeFunCall+  :: RValue -- ^ Receiver.+  -> String -- ^ Method name.+  -> [RValue] -- ^ Arguments. Please note that the maximum number of arguments is 16.+  -> IO (Either (String, RValue) RValue) -- ^ Returns either an error message / value couple, or the value returned by the function.+safeFunCall recv methodname args+  | length args > 16 = pure $ Left ("too many arguments", rbNil)+  | otherwise =+      rb_intern methodname >>= \methodid ->+      with (ShimDispatch recv methodid args) $ \dispatch ->+      with 0 $ \pstatus -> do+        o <- c_rb_protect safeCallback (castPtr dispatch) pstatus+        status <- peek pstatus+        if status == 0+          then pure $ Right o+          else do+            err <- showErrorStack+            pure $ Left (err, o)  -- | Gives a (multiline) error friendly string representation of the last -- error.

@@ -15,6 +15,7 @@     , loadFile     , embedHaskellValue     , safeMethodCall+    , safeFunCall     , makeSafe     , fromRuby     , toRuby@@ -115,7 +116,7 @@ embedHaskellValue :: RubyInterpreter -> a -> IO (Either RubyError RValue) embedHaskellValue int v = makeSafe int $ FR.embedHaskellValue v --- | A safe version of the corresponding "Foreign.Ruby" function.+-- | A safe version of the corresponding "Foreign.Ruby.Helper" function. safeMethodCall :: RubyInterpreter                -> String                -> String@@ -123,6 +124,19 @@                -> IO (Either RubyError RValue) safeMethodCall int className methodName args = do     o <- makeSafe int $ FR.safeMethodCall className methodName args+    case o of+        Left x -> return (Left x)+        Right (Right v) -> return (Right v)+        Right (Left (s,v)) -> return (Left (WithOutput s v))++-- | A safe version of the corresponding "Foreign.Ruby.Helper" function.+safeFunCall :: RubyInterpreter+            -> RValue+            -> String+            -> [RValue]+            -> IO (Either RubyError RValue)+safeFunCall int receiver methodName args = do+    o <- makeSafe int $ FR.safeFunCall receiver methodName args     case o of         Left x -> return (Left x)         Right (Right v) -> return (Right v)

@@ -29,13 +29,14 @@ VALUE safeCall(VALUE args) { 	struct s_dispatch * d = (struct s_dispatch *) args;-	VALUE myclass = rb_const_get(rb_cObject, rb_intern(d->classname));-	VALUE o = rb_funcall2(myclass, rb_intern(d->methodname), d->nbargs, d->args);-	free(d->methodname);-	free(d->classname);-	return o;+	return rb_funcall2(d->receiver, d->methodid, d->nbargs, d->args); } +VALUE getRubyCObject(VALUE name)+{+	return rb_const_get(rb_cObject, rb_intern((const char*) name));+}+ long arrayLength(VALUE r) { 	return RARRAY_LEN(r);@@ -64,4 +65,3 @@ double num2dbl(VALUE v) { 	NUM2DBL(v); }-

@@ -6,8 +6,8 @@ void ruby_initialization(void);  struct s_dispatch {-	char * classname;-	char * methodname;+	VALUE receiver;+	ID methodid; 	int nbargs; 	VALUE args[16]; };

@@ -1,6 +1,6 @@ cabal-version:       >= 1.10 name:                hruby-version:             0.3.7+version:             0.3.8 synopsis:            Embed a Ruby intepreter in your Haskell program ! description:         This doesn't work with Ruby 1.9. Everything you need should be in Foreign.Ruby.Safe. license:             BSD3

@@ -3,6 +3,7 @@ import Foreign.Ruby import Data.Aeson import Control.Monad+import System.Exit (exitFailure) import Test.QuickCheck import Test.QuickCheck.Monadic import qualified Data.Text as T@@ -54,4 +55,5 @@ main :: IO () main = withRubyInterpreter $ \i -> do     loadFile i "./test/test.rb" >>= either (error . show) return-    quickCheckWith (stdArgs { maxSuccess = 1000 } ) (roundTrip i)+    result <- quickCheckWithResult (stdArgs { maxSuccess = 1000 } ) (roundTrip i)+    unless (isSuccess result) exitFailure