packages feed

hruby (empty) → 0.0.3

raw patch · 11 files changed

+796/−0 lines, 11 filesdep +QuickCheckdep +aesondep +attoparsecsetup-changed

Dependencies added: QuickCheck, aeson, attoparsec, base, bytestring, hruby, text, unordered-containers, vector

Files

+ Foreign/Ruby.hs view
@@ -0,0 +1,61 @@+-- | This is the main module of this library. Other functionnalities are+-- exposed in "Foreign.Ruby.Bindings" and "Foreign.Ruby.Helpers", but this+-- should be enough for most cases.+module Foreign.Ruby+    ( -- * Initialization / cleanup+      initialize+    , finalize+    -- * Converting from and to Ruby values+    , RValue+    , RID+    , FromRuby (fromRuby)+    , ToRuby (toRuby)+    , getSymbol+    -- * Callbacks+    -- | These functions could be used to call Haskell functions from the Ruby+    -- world. While fancier stuff could be achieved by tapping into+    -- "Foreign.Ruby.Bindings", those methods should be easy to use and should+    -- cover most use cases.+    --+    -- The `embedHaskellValue`, `extractHaskellValue` and+    -- `freeHaskellValue` functions are very unsafe, and should be used only in very+    -- controlled environments.+    , embedHaskellValue+    , extractHaskellValue+    , freeHaskellValue+    , mkRegistered0+    , mkRegistered1+    , mkRegistered2+    , rb_define_global_function+    -- * GC control+    -- | This is a critical part of embedding the Ruby interpreter. Data+    -- created using the `toRuby` function might be collected at any time.+    -- For now, the solution is to disable the GC mechanism during calls to+    -- Ruby functions. If someone knows of a better solution, please+    -- contact the author of this library.+    , setGC+    , startGC+    , freezeGC+    -- * Interacting with the interpreter+    , rb_load_protect+    , safeMethodCall+    -- * Error handling+    , showErrorStack+    )+where++import Foreign.Ruby.Helpers+import Foreign.Ruby.Bindings++-- | You must run this before anything else.+initialize :: IO ()+initialize = ruby_init >> ruby_init_loadpath++-- | You might want to run this when you are done with all the Ruby stuff.+finalize :: IO ()+finalize = ruby_finalize++-- | Gets the `RValue` correponding to the given named symbol.+getSymbol :: String -> IO RValue+getSymbol = fmap id2sym . rb_intern+
+ Foreign/Ruby/Bindings.hsc view
@@ -0,0 +1,275 @@+{-# LANGUAGE ForeignFunctionInterface, FlexibleInstances #-}++#include "shim.h"++module Foreign.Ruby.Bindings where++import Foreign+import Foreign.C++-- | This is the type of Ruby values. It is defined as a pointer to some unsigned long, just like Ruby does. The actual value is either pointed to, or encoded in the pointer.+type RValue = Ptr CULong++-- | The Ruby ID type, mostly used for symbols.+type RID = CULong++data ShimDispatch = ShimDispatch String String [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)+                  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, nbargs) ptr (length vals)+        let arrayblock = (#ptr struct s_dispatch, args) ptr+        pokeArray arrayblock vals++builtinToInt :: RBuiltin -> CULong+builtinToInt RNONE   = 0x00+builtinToInt RNIL    = 0x01+builtinToInt ROBJECT = 0x02+builtinToInt RCLASS  = 0x03+builtinToInt RICLASS = 0x04+builtinToInt RMODULE = 0x05+builtinToInt RFLOAT  = 0x06+builtinToInt RSTRING = 0x07+builtinToInt RREGEXP = 0x08+builtinToInt RARRAY  = 0x09+builtinToInt RFIXNUM = 0x0a+builtinToInt RHASH   = 0x0b+builtinToInt RSTRUCT = 0x0c+builtinToInt RBIGNUM = 0x0d+builtinToInt RFILE   = 0x0e+builtinToInt RTRUE   = 0x20+builtinToInt RFALSE  = 0x21+builtinToInt RDATA   = 0x22+builtinToInt RMATCH  = 0x23+builtinToInt RSYMBOL = 0x24+builtinToInt RBLKTAG = 0x3b+builtinToInt RUNDEF  = 0x3c+builtinToInt RVARMAP = 0x3d+builtinToInt RSCOPE  = 0x3e+builtinToInt RNODE   = 0x3f++intToBuiltin :: CULong -> RBuiltin+-- intToBuiltin 0x00 = RNONE+intToBuiltin 0x01 = RNIL+intToBuiltin 0x02 = ROBJECT+intToBuiltin 0x03 = RCLASS+intToBuiltin 0x04 = RICLASS+intToBuiltin 0x05 = RMODULE+intToBuiltin 0x06 = RFLOAT+intToBuiltin 0x07 = RSTRING+intToBuiltin 0x08 = RREGEXP+intToBuiltin 0x09 = RARRAY+intToBuiltin 0x0a = RFIXNUM+intToBuiltin 0x0b = RHASH+intToBuiltin 0x0c = RSTRUCT+intToBuiltin 0x0d = RBIGNUM+intToBuiltin 0x0e = RFILE+intToBuiltin 0x20 = RTRUE+intToBuiltin 0x21 = RFALSE+intToBuiltin 0x22 = RDATA+intToBuiltin 0x23 = RMATCH+intToBuiltin 0x24 = RSYMBOL+intToBuiltin 0x3b = RBLKTAG+intToBuiltin 0x3c = RUNDEF+intToBuiltin 0x3d = RVARMAP+intToBuiltin 0x3e = RSCOPE+intToBuiltin 0x3f = RNODE+intToBuiltin _ = RNONE++-- | The ruby built-in types+data RBuiltin = RNONE+              | RNIL+              | ROBJECT+              | RCLASS+              | RICLASS+              | RMODULE+              | RFLOAT+              | RSTRING+              | RREGEXP+              | RARRAY+              | RFIXNUM+              | RHASH+              | RSTRUCT+              | RBIGNUM+              | RFILE+              | RTRUE+              | RFALSE+              | RDATA+              | RMATCH+              | RSYMBOL+              | RBLKTAG+              | RUNDEF+              | RVARMAP+              | RSCOPE+              | RNODE+              deriving (Show)++-- | Ruby native types, as encoded in the Value type.+data RType = RFixNum+           | RNil+           | RFalse+           | RTrue+           | RSymbol+           | RBuiltin RBuiltin+           deriving (Show)++type Registered0 = IO RValue+type Registered1 = RValue -> IO RValue+type Registered2 = RValue -> RValue -> IO RValue++-- | Creates a function pointer suitable for usage with `rb_define_global_function` of type `Registered0` (with 0 arguments).+foreign import ccall "wrapper" mkRegistered0 :: Registered0 -> IO (FunPtr Registered0)+-- | Creates a function pointer suitable for usage with `rb_define_global_function` of type `Registered1` (with 1 `RValue` arguments).+foreign import ccall "wrapper" mkRegistered1 :: Registered1 -> IO (FunPtr Registered1)+-- | Creates a function pointer suitable for usage with `rb_define_global_function` of type `Registered2` (with 2 `RValue` arguments).+foreign import ccall "wrapper" mkRegistered2 :: Registered2 -> IO (FunPtr Registered2)++type RegisteredCB3 = RValue -> RValue -> RValue -> IO Int+foreign import ccall "wrapper" mkRegisteredCB3 :: RegisteredCB3 -> IO (FunPtr RegisteredCB3)++foreign import ccall "ruby_init"                 ruby_init                   :: IO ()+foreign import ccall "ruby_finalize"             ruby_finalize               :: IO ()+foreign import ccall "ruby_init_loadpath"        ruby_init_loadpath          :: IO ()+foreign import ccall "rb_str_new2"               c_rb_str_new2               :: CString -> IO RValue+foreign import ccall "rb_load_protect"           c_rb_load_protect           :: RValue -> Int -> Ptr Int -> IO ()+foreign import ccall "rb_funcall"                c_rb_funcall_0              :: RValue -> RID -> Int -> IO RValue+foreign import ccall "rb_funcall"                c_rb_funcall_1              :: RValue -> RID -> Int -> RValue -> IO RValue+foreign import ccall "rb_funcall"                c_rb_funcall_2              :: RValue -> RID -> Int -> RValue -> RValue -> IO RValue+foreign import ccall "rb_funcall"                c_rb_funcall_3              :: RValue -> RID -> Int -> RValue -> RValue -> RValue -> IO RValue+foreign import ccall "rb_funcall"                c_rb_funcall_4              :: RValue -> RID -> Int -> RValue -> RValue -> RValue -> RValue -> IO RValue+foreign import ccall "rb_funcall"                c_rb_funcall_5              :: RValue -> RID -> Int -> RValue -> RValue -> RValue -> RValue -> RValue -> IO RValue+foreign import ccall "rb_gv_get"                 c_rb_gv_get                 :: CString -> IO RValue+foreign import ccall "rb_intern"                 c_rb_intern                 :: CString -> IO RID+foreign import ccall "rb_id2name"                rb_id2name                  :: RID -> IO CString+foreign import ccall "rb_string_value_ptr"       c_rb_string_value_ptr       :: Ptr RValue -> IO CString+foreign import ccall "&rb_cObject"               rb_cObject                  :: Ptr RValue+foreign import ccall "&ruby_errinfo"             ruby_errinfo                :: Ptr RValue+foreign import ccall "rb_define_class"           c_rb_define_class           :: CString -> RValue -> IO RValue+foreign import ccall "rb_define_method"          c_rb_define_method          :: RValue -> CString -> FunPtr a -> Int -> IO ()+foreign import ccall "rb_define_global_function" c_rb_define_global_function :: CString -> FunPtr a -> Int -> IO ()+foreign import ccall "rb_const_get"              rb_const_get                :: RValue -> RID -> IO RValue+foreign import ccall "&safeCall"                 safeCallback                :: FunPtr (RValue -> IO RValue)+foreign import ccall "rb_protect"                c_rb_protect                :: FunPtr (RValue -> IO RValue) -> RValue -> Ptr Int -> IO RValue+foreign import ccall "rb_string_value_cstr"      c_rb_string_value_cstr      :: Ptr RValue -> IO CString+foreign import ccall "rb_ary_new"                rb_ary_new                  :: IO RValue+foreign import ccall "rb_ary_new2"               rb_ary_new2                 :: CLong -> IO RValue+foreign import ccall "rb_ary_new4"               rb_ary_new4                 :: CLong -> Ptr RValue -> IO RValue+foreign import ccall "rb_ary_push"               rb_ary_push                 :: RValue -> RValue -> IO RValue+foreign import ccall "rb_ary_entry"              rb_ary_entry                :: RValue -> CLong -> IO RValue+foreign import ccall "rb_hash_foreach"           rb_hash_foreach             :: RValue -> FunPtr a -> RValue -> IO ()+foreign import ccall "rb_big2str"                rb_big2str                  :: RValue -> CInt -> IO RValue+foreign import ccall "rb_cstr_to_inum"           rb_cstr_to_inum             :: CString -> CInt -> CInt -> IO RValue+foreign import ccall "rb_float_new"              rb_float_new                :: Double -> IO RValue+foreign import ccall "rb_hash_new"               rb_hash_new                 :: IO RValue+foreign import ccall "rb_hash_aset"              rb_hash_aset                :: RValue -> RValue -> RValue -> IO RValue+foreign import ccall "rb_define_module"          c_rb_define_module          :: CString -> IO ()++sym2id :: RValue -> RID+sym2id x = (fromIntegral (ptrToIntPtr x)) `shiftR` 8++id2sym :: RID -> RValue+id2sym x = intPtrToPtr (fromIntegral ( (x `shiftL` 8) .|. 0x0e ))++rbFalse :: RValue+rbFalse = intPtrToPtr 0+rbTrue :: RValue+rbTrue = intPtrToPtr 2+rbNil :: RValue+rbNil = intPtrToPtr 4++rtype :: RValue -> IO RType+rtype rv | ptrToIntPtr rv .&. 1 == 1 = return RFixNum+         | ptrToIntPtr rv  == 0 = return RFalse+         | ptrToIntPtr rv  == 2 = return RTrue+         | ptrToIntPtr rv  == 4 = return RNil+         | ptrToIntPtr rv .&. 0xff == 0x0e = return RSymbol+         | otherwise = fmap (RBuiltin . intToBuiltin . (.&. 0x3f)) (peek rv)+++peekArrayLength :: RValue -> IO CLong+peekArrayLength = (#peek struct RArray, len)++peekRFloatValue :: RValue -> IO Double+peekRFloatValue = (#peek struct RFloat, value)++rb_string_value_cstr :: RValue -> IO String+rb_string_value_cstr v = do+    pv <- new v+    o <- c_rb_string_value_cstr pv >>= peekCString+    free pv+    return o++-- | Defines a global function that can be called from the Ruby world. This function must only accept `RValue`s as arguments.+rb_define_global_function :: String -- ^ Name of the function+                          -> FunPtr a -- ^ Pointer to the function (created with something like `mkRegistered0`)+                          -> Int -- ^ Number of arguments the function accepts.+                          -> IO ()+rb_define_global_function s f i = withCString s (\cs -> c_rb_define_global_function cs f i)++rb_define_method :: RValue -> String -> FunPtr a -> Int -> IO ()+rb_define_method r s f i = withCString s (\cs -> c_rb_define_method r cs f i)++rb_define_class :: String  -> RValue -> IO RValue+rb_define_class str rv = withCString str (\s -> c_rb_define_class s rv)++rb_str_new2 :: String -> IO RValue+rb_str_new2 str = withCString str c_rb_str_new2++rb_define_module :: String -> IO ()+rb_define_module str = withCString str c_rb_define_module++-- | Loads a ruby script (and executes it).+rb_load_protect :: String -- ^ Path to the script+                -> Int -- ^ Just set this to 0, unless you know what you are doing+                -> IO Int -- ^ Return code, equal to 0 if everything went right. `showErrorStack` can be used in case of errors.+rb_load_protect rv a = do+    bptr <- new 0+    rvs <- rb_str_new2 rv+    c_rb_load_protect rvs a bptr+    status <- peek bptr+    free bptr+    return status++rb_funcall :: RValue -> RID -> [RValue] -> IO RValue+rb_funcall a b []          = c_rb_funcall_0 a b 0+rb_funcall a b [d]         = c_rb_funcall_1 a b 1 d+rb_funcall a b [d,e]       = c_rb_funcall_2 a b 2 d e+rb_funcall a b [d,e,f]     = c_rb_funcall_3 a b 3 d e f+rb_funcall a b [d,e,f,g]   = c_rb_funcall_4 a b 4 d e f g+rb_funcall a b [d,e,f,g,h] = c_rb_funcall_5 a b 5 d e f g h+rb_funcall _ _ _           = error "Can't call functions with that many arguments"++rbMethodCall :: String -> String -> [RValue] -> IO RValue+rbMethodCall classname methodname args = do+    c <- getClass classname+    m <- rb_intern methodname+    rb_funcall c m args++getClass :: String -> IO RValue+getClass s = do+    i <- rb_intern s+    o <- peek rb_cObject+    rb_const_get o i++rb_gv_get :: String -> IO RValue+rb_gv_get s = withCString s c_rb_gv_get++rb_intern :: String -> IO RID+rb_intern s = withCString s c_rb_intern++rb_string_value_ptr :: RValue -> IO String+rb_string_value_ptr rv = do+    rvp <- new rv+    o <- c_rb_string_value_ptr rvp >>= peekCString+    free rvp+    return o++
+ Foreign/Ruby/Helpers.hs view
@@ -0,0 +1,267 @@+module Foreign.Ruby.Helpers where++import Foreign.Ruby.Bindings++import Data.Maybe (fromMaybe)+import Foreign+import Data.Aeson+import Control.Monad+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.ByteString.Char8 as BS+import Data.Attoparsec.Number+import qualified Data.Vector as V+import Data.IORef+import qualified Data.HashMap.Strict as HM++-- | The class of things that can be converted from Ruby values. Note that+-- there are a ton of stuff that are Ruby values, hence the `Maybe` type,+-- as the instances will probably be incomplete.+class FromRuby a where+    -- | To define more instances, please look at the instances defined in+    -- "Foreign.Ruby.Helpers".+    fromRuby :: RValue -> IO (Maybe a)++-- | Whenever you use `ToRuby`, don't forget to use something like+-- `freezeGC` or you will get random segfaults.+class ToRuby a where+    toRuby   :: a -> IO RValue++fromRubyIntegral :: Integral n => RValue -> IO (Maybe n)+fromRubyIntegral r = do+    t <- rtype r+    case t of+        RFixNum -> return (Just (fromIntegral (ptrToIntPtr r `shiftR` 1)))+        _ -> return Nothing+toRubyIntegral :: Integral n => n -> IO RValue+toRubyIntegral n = return (intPtrToPtr ( (fromIntegral n `shiftL` 1) .|. 1))++fromRubyArray :: FromRuby a => RValue -> IO (Maybe [a])+fromRubyArray v = do+    nbelems <- peekArrayLength v+    fmap sequence (forM [0..(nbelems-1)] (rb_ary_entry v >=> fromRuby))++instance FromRuby a => FromRuby [a] where+    fromRuby v = do+        t <- rtype v+        case t of+            RBuiltin RARRAY -> fromRubyArray v+            _ -> putStrLn ("not an array! " ++ show t) >> return Nothing++instance ToRuby a => ToRuby [a] where+    toRuby lst = do+        vals <- mapM toRuby lst+        Foreign.withArray vals (rb_ary_new4 (fromIntegral (length lst)))++instance FromRuby BS.ByteString where+    fromRuby v = do+        t <- rtype v+        case t of+            RBuiltin RSTRING -> do+                pv <- new v+                cstr <- c_rb_string_value_cstr pv+                free pv+                fmap Just (BS.packCString cstr)+            RSymbol -> fmap Just (rb_id2name (sym2id v) >>= BS.packCString)+            _ -> return Nothing+instance ToRuby BS.ByteString where+    toRuby s = BS.useAsCString s c_rb_str_new2++instance FromRuby T.Text where+    fromRuby = fmap (fmap T.decodeUtf8) . fromRuby+instance ToRuby T.Text where+    toRuby = toRuby . T.encodeUtf8++instance ToRuby Double where+    toRuby = rb_float_new+instance FromRuby Double where+    fromRuby = fmap Just . peekRFloatValue++instance FromRuby Integer where+    fromRuby = fromRubyIntegral+instance ToRuby Integer where+    toRuby = toRubyIntegral+instance FromRuby Int where+    fromRuby = fromRubyIntegral+instance ToRuby Int where+    toRuby = toRubyIntegral++-- | This is the most complete instance that is provided in this module.+-- Please note that it is far from being sufficient for even basic+-- requirements. For example, the `Value` type can only encode+-- dictionnaries with keys that can be converted to strings.+instance FromRuby Value where+    fromRuby v = do+        t <- rtype v+        case t of+            RFixNum          -> fmap (fmap (Number . I)) (fromRuby v)+            RNil             -> return (Just Null)+            RFalse           -> return (Just (Bool False))+            RTrue            -> return (Just (Bool True))+            RSymbol          -> fmap (fmap (String . T.decodeUtf8)) (fromRuby v)+            RBuiltin RNIL    -> return (Just Null)+            RBuiltin RSTRING -> fmap (fmap (String . T.decodeUtf8)) (fromRuby v)+            RBuiltin RARRAY  -> fmap (fmap (Array . V.fromList)) (fromRubyArray v)+            RBuiltin RTRUE   -> return (Just (Bool True))+            RBuiltin RFALSE  -> return (Just (Bool False))+            RBuiltin RUNDEF  -> return (Just Null)+            RBuiltin RFLOAT  -> fmap (fmap (Number . D)) (fromRuby v)+            RBuiltin RBIGNUM -> do+                bs <- rb_big2str v 10 >>= fromRuby+                case fmap BS.readInteger bs of+                    Just (Just (x,"")) -> return (Just (Number (I x)))+                    _ -> return Nothing+            RBuiltin RNONE -> return (Just Null)+            RBuiltin RHASH   -> do+                var <- newIORef []+                let appender :: RValue -> RValue -> RValue -> IO Int+                    appender key val _ = do+                        vvar <- readIORef var+                        vk <- fromRuby key+                        vv <- fromRuby val+                        case (vk, vv) of+                            (Just jk, Just jv) -> writeIORef var ( (jk,jv) : vvar ) >> return 0+                            _ -> return 1+                    toHash = Object . HM.fromList+                wappender <- mkRegisteredCB3 appender+                rb_hash_foreach v wappender rbNil+                freeHaskellFunPtr wappender+                fmap (Just . toHash) (readIORef var)+            _ -> do+                putStrLn ("Could not decode: " ++ show t)+                return Nothing++instance ToRuby Value where+    toRuby (Number (I x)) = do+        let maxRubyInt = fromIntegral (maxBound :: IntPtr) `shiftR` 1 :: Integer+        if x >= maxRubyInt+            then BS.useAsCString (BS.pack (show x)) (\cs -> rb_cstr_to_inum cs 10 0)+            else toRubyIntegral x+    toRuby (Number (D x)) = toRuby x+    toRuby (String t) = let bs = T.encodeUtf8 t+                        in  BS.useAsCString bs c_rb_str_new2+    toRuby Null = return rbNil+    toRuby (Bool True) = return rbTrue+    toRuby (Bool False) = return rbFalse+    toRuby (Array ar) = toRuby (V.toList ar)+    toRuby (Object m) = do+        hash <- rb_hash_new+        forM_ (HM.toList m) $ \(k, v) -> do+            rk <- toRuby k+            rv <- toRuby v+            rb_hash_aset hash rk rv+        return hash++-- | This transforms any Haskell value into a Ruby big integer encoding the+-- address of the corresponding `StablePtr`. This is useful when you want+-- to pass such values to a Ruby program that will call Haskell functions.+--+-- This is probably a bad idea to do this. The use case is for calling+-- Haskell functions from Ruby, using values generated from the Haskell+-- world. If your main program is in Haskell, you should probably wrap+-- a function partially applied with the value you would want to embed.+embedHaskellValue :: a -> IO RValue+embedHaskellValue v = do+    intptr <- fmap (fromIntegral . ptrToIntPtr . castStablePtrToPtr) (newStablePtr v) :: IO Integer+    toRuby intptr++-- | Frees the Haskell value represented by the corresponding `RValue`.+-- This is probably extremely unsafe to do, and will most certainly lead to+-- exploitable security bug if you use something modified from Ruby land.+-- You should always free the `RValue` you generated from+-- `embedHaskellValue`.+freeHaskellValue :: RValue -> IO ()+freeHaskellValue v = do+    intptr <- fromRuby v :: IO (Maybe Integer)+    case intptr of+        Just i -> freeStablePtr (castPtrToStablePtr (intPtrToPtr (fromIntegral i)))+        Nothing -> error "Could not decode embedded value during free!"++-- | This is unsafe as hell, so you'd better be certain this RValue has not+-- been tempered with : GC frozen, bugfree Ruby scripts.+--+-- If it has been tempered by an attacker, you are probably looking at+-- a good vector for arbitrary code execution.+extractHaskellValue :: RValue -> IO a+extractHaskellValue v = do+    intptr <- fromRuby v :: IO (Maybe Integer)+    case intptr of+        Just i -> deRefStablePtr (castPtrToStablePtr (intPtrToPtr (fromIntegral i)))+        Nothing -> error "Could not decode embedded value!"++runscript :: String -> IO (Either String ())+runscript filename = do+    ruby_init+    ruby_init_loadpath+    status <- rb_load_protect filename 0+    if status == 0+        then ruby_finalize >> return (Right ())+        else do+            r <- showErrorStack+            ruby_finalize+            return (Left r)++defineGlobalClass :: String -> IO RValue+defineGlobalClass s = peek rb_cObject >>= rb_define_class s++-- | Runs a Ruby method, capturing errors.+safeMethodCall :: String -- ^ Class name.+               -> 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))++-- | Gives a (multiline) error friendly string representation of the last+-- error.+showErrorStack :: IO String+showErrorStack = do+    runtimeerror <- rb_gv_get "$!"+    m <- if runtimeerror == rbNil+             then return "Unknown runtime error"+             else do+                 message <- rb_intern "message"+                 fmap (fromMaybe "undeserializable error") (rb_funcall runtimeerror message [] >>= fromRuby)+    rbt <- rb_gv_get "$@"+    bt <- if rbt == rbNil+              then return []+              else fmap (fromMaybe []) (fromRuby rbt)+    return (T.unpack (T.unlines (m : bt)))++-- | Sets the current GC operation. Please note that this could be modified+-- from Ruby scripts.+setGC :: Bool -- ^ Set to `True` to enable GC, and to `False` to disable it.+      -> IO (Either (String, RValue) RValue)+setGC nw = do+    let method = if nw+                     then "enable"+                     else "disable"+    safeMethodCall "GC" method []++-- | Runs the Ruby garbage collector.+startGC :: IO ()+startGC = Control.Monad.void (safeMethodCall "GC" "start" [])++-- | Runs a computation with the Ruby GC disabled. Once the computation is over, GC+-- will be re-enabled and the `startGC` function run.+freezeGC :: IO a -> IO a+freezeGC computation = do+    Control.Monad.void (setGC False)+    o <- computation+    Control.Monad.void (setGC True)+    startGC+    return o+
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2012, Simon Marechal++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Simon Marechal nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cbits1.8/shim.c view
@@ -0,0 +1,12 @@+#include "shim.h"++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;+}+
+ cbits1.8/shim.h view
@@ -0,0 +1,11 @@+#include "/usr/lib/ruby/1.8/x86_64-linux/ruby.h"++struct s_dispatch {+	char * classname;+	char * methodname;+	int nbargs;+	VALUE args[16];+};++VALUE safeCall(VALUE args);+
+ cbits1.9/shim.c view
@@ -0,0 +1,12 @@+#include "shim.h"++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;+}+
+ cbits1.9/shim.h view
@@ -0,0 +1,11 @@+#include "/usr/lib/ruby/1.8/x86_64-linux/ruby.h"++struct s_dispatch {+	char * classname;+	char * methodname;+	int nbargs;+	VALUE args[16];+};++VALUE safeCall(VALUE args);+
+ hruby.cabal view
@@ -0,0 +1,50 @@+-- Initial hruby.cabal generated by cabal init.  For further documentation,+--  see http://haskell.org/cabal/users-guide/++name:                hruby+version:             0.0.3+synopsis:            Embed Ruby in your Haskell program.+description:         Warning: this is completely experimental. Everything you need should be in "Foreign.Ruby".+license:             BSD3+license-file:        LICENSE+author:              Simon Marechal+maintainer:          bartavelle@gmail.com+-- copyright:           +category:            Language+build-type:          Simple+cabal-version:       >=1.8++Flag Ruby19+    Description: Enable when you use Ruby 1.9 (not implemented yet). It will default to Ruby 1.8.+    Default: False++source-repository head+  type: git+  location: git://github.com/bartavelle/hruby.git+++library+  exposed-modules:      Foreign.Ruby, Foreign.Ruby.Bindings, Foreign.Ruby.Helpers+  ghc-options:          -Wall+  extensions:           BangPatterns, OverloadedStrings+  build-depends:        base ==4.6.*, aeson, bytestring, attoparsec, vector, text, unordered-containers+  if flag(ruby19)+      extra-libraries:      ruby1.9+      c-sources:            cbits1.9/shim.c+      install-includes:     cbits1.9/shim.h+      include-dirs:         cbits1.9+  else+      extra-libraries:      ruby1.8+      c-sources:            cbits1.8/shim.c+      install-includes:     cbits1.8/shim.h+      include-dirs:         cbits1.8++Test-Suite test-roundtrip+  hs-source-dirs: test+  type:           exitcode-stdio-1.0+  ghc-options:    -Wall+  extensions:     OverloadedStrings+  build-depends:  base,hruby,aeson,QuickCheck,text,attoparsec,vector+  main-is:        roundtrip.hs++
+ test/roundtrip.hs view
@@ -0,0 +1,65 @@+module Main where++import Foreign.Ruby.Helpers+import Foreign.Ruby.Bindings+import Data.Aeson+import Control.Monad+import Test.QuickCheck+import Test.QuickCheck.Monadic+import qualified Data.Text as T+import Data.Attoparsec.Number+import qualified Data.Vector as V++instance Arbitrary Number where+    arbitrary = frequency [ (1, fmap D arbitrary) , (1, fmap I arbitrary) ]++subvalue :: Gen Value+subvalue = frequency [(50,s),(20,b),(20,n),(1,h),(1,a)]++str :: Gen T.Text+str = fmap T.pack (listOf (elements (['A'..'Z'] ++ ['a' .. 'z'] ++ ['0'..'9'])))++s :: Gen Value+s = fmap String str++a :: Gen Value+a = fmap (Array . V.fromList) (resize 100 (listOf subvalue))++b :: Gen Value+b = fmap Bool arbitrary++n :: Gen Value+n = fmap Number arbitrary++h :: Gen Value+h = fmap object $ do+        k <- listOf str+        v <- listOf subvalue+        return (zip k v)++instance Arbitrary Value where+    arbitrary = frequency [(1,s),(5,a),(1,b),(1,n),(5,h)]++roundTrip :: Property+roundTrip = monadicIO $ do+    v <- pick (arbitrary :: Gen Value)+    void (run (setGC False))+    rub <- run (toRuby v)+    nxt <- run (safeMethodCall "TestClass" "testfunc" [rub])+    case nxt of+        Right x -> do+            out <- run (fromRuby x)+            void (run (setGC True))+            run startGC+            assert (Just v == out)+        Left (rr,_) -> run (print rr) >> assert False++main :: IO ()+main = do+    ruby_init+    ruby_init_loadpath+    rb_define_module "test"+    st <- rb_load_protect "test/test.rb" 0+    unless (st == 0) (showErrorStack >>= error)+    quickCheckWith (stdArgs { maxSuccess = 1000 } ) roundTrip+    ruby_finalize