hruby 0.2.9 → 0.3.0
raw patch · 5 files changed
+147/−142 lines, 5 files
Files
- Foreign/Ruby.hs +47/−54
- Foreign/Ruby/Helpers.hs +33/−42
- Foreign/Ruby/Safe.hs +51/−19
- hruby.cabal +3/−1
- test/roundtrip.hs +13/−26
Foreign/Ruby.hs view
@@ -1,63 +1,56 @@--- | 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.+-- | The embedded Ruby interpreter must run on its own thread. The functions+-- in this module should enforce this property. For lower level access,+-- please look at "Foreign.Ruby.Bindings" and "Foreign.Ruby.Helpers".+--+-- > withRubyInterpreter $ \i -> do+-- > dsqsddqs 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- -- * Various- , rb_iv_set- )+( -- * Initialization / cleanup+ RubyInterpreter+ , startRubyInterpreter+ , closeRubyInterpreter+ , withRubyInterpreter+ -- * Running Ruby actions+ , loadFile+ , Foreign.Ruby.Safe.embedHaskellValue+ , Foreign.Ruby.Safe.safeMethodCall+ , makeSafe+ , RubyError(..)+ -- * Converting to and from Ruby values+ , RValue+ , RID+ , Foreign.Ruby.Safe.fromRuby+ , Foreign.Ruby.Safe.toRuby+ , Foreign.Ruby.Safe.freezeGC+ , 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.+ , freeHaskellValue+ , extractHaskellValue+ , RubyFunction1+ , RubyFunction2+ , RubyFunction3+ , RubyFunction4+ , RubyFunction5+ , registerGlobalFunction1+ , registerGlobalFunction2+ , registerGlobalFunction3+ , registerGlobalFunction4+ , registerGlobalFunction5+ ) where +import Foreign.Ruby.Safe 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/Helpers.hs view
@@ -3,7 +3,6 @@ import Foreign.Ruby.Bindings -import Data.Maybe (fromMaybe) import Foreign import Data.Aeson import Control.Monad@@ -21,19 +20,19 @@ class FromRuby a where -- | To define more instances, please look at the instances defined in -- "Foreign.Ruby.Helpers".- fromRuby :: RValue -> IO (Maybe a)+ fromRuby :: RValue -> IO (Either String 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 = fmap (Just . fromIntegral) . num2long+fromRubyIntegral :: Integral n => RValue -> IO (Either String n)+fromRubyIntegral = fmap (Right . fromIntegral) . num2long toRubyIntegral :: Integral n => n -> IO RValue toRubyIntegral = int2num . fromIntegral -fromRubyArray :: FromRuby a => RValue -> IO (Maybe [a])+fromRubyArray :: FromRuby a => RValue -> IO (Either String [a]) fromRubyArray v = do nbelems <- arrayLength v fmap sequence (forM [0..(nbelems-1)] (rb_ary_entry v >=> fromRuby))@@ -43,7 +42,7 @@ t <- rtype v case t of RBuiltin RARRAY -> fromRubyArray v- _ -> putStrLn ("not an array! " ++ show t) >> return Nothing+ _ -> return $ Left ("not an array! " ++ show t) instance ToRuby a => ToRuby [a] where toRuby lst = do@@ -58,9 +57,9 @@ 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+ fmap Right (BS.packCString cstr)+ RSymbol -> fmap Right (rb_id2name (sym2id v) >>= BS.packCString)+ _ -> return (Left ("Expected a string, not " ++ show t)) instance ToRuby BS.ByteString where toRuby s = BS.useAsCString s c_rb_str_new2 @@ -72,7 +71,7 @@ instance ToRuby Double where toRuby = newFloat instance FromRuby Double where- fromRuby = fmap Just . num2dbl+ fromRuby = fmap Right . num2dbl instance FromRuby Integer where fromRuby = fromRubyIntegral@@ -92,23 +91,24 @@ t <- rtype v case t of RFixNum -> fmap (fmap (Number . (fromIntegral :: Integer -> Scientific))) (fromRuby v)- RNil -> return (Just Null)- RFalse -> return (Just (Bool False))- RTrue -> return (Just (Bool True))+ RNil -> return (Right Null)+ RFalse -> return (Right (Bool False))+ RTrue -> return (Right (Bool True)) RSymbol -> fmap (fmap (String . T.decodeUtf8)) (fromRuby v)- RBuiltin RNIL -> return (Just Null)+ RBuiltin RNIL -> return (Right 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 RTRUE -> return (Right (Bool True))+ RBuiltin RFALSE -> return (Right (Bool False))+ RBuiltin RUNDEF -> return (Right Null) RBuiltin RFLOAT -> fmap (fmap (Number . fromRational . (toRational :: Double -> Rational))) (fromRuby v) RBuiltin RBIGNUM -> do bs <- rb_big2str v 10 >>= fromRuby- case fmap BS.readInteger bs of- Just (Just (x,"")) -> return (Just (Number (fromIntegral x)))- _ -> return Nothing- RBuiltin RNONE -> return (Just Null)+ return $ case fmap BS.readInteger bs of+ Right (Just (x,"")) -> Right (Number (fromIntegral x))+ Right _ -> Left ("Expected an integer, not " ++ show bs)+ Left rr -> Left rr+ RBuiltin RNONE -> return (Right Null) RBuiltin RHASH -> do var <- newIORef [] let appender :: RValue -> RValue -> RValue -> IO Int@@ -117,16 +117,14 @@ vk <- fromRuby key vv <- fromRuby val case (vk, vv) of- (Just jk, Just jv) -> writeIORef var ( (jk,jv) : vvar ) >> return 0+ (Right jk, Right 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+ fmap (Right . toHash) (readIORef var)+ _ -> return $ Left ("Could not decode: " ++ show t) instance ToRuby Scientific where toRuby s | base10Exponent s >= 0 = toRuby (coefficient s)@@ -148,14 +146,7 @@ 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.+-- | An unsafe version of the corresponding "Foreign.Ruby.Safe" function. embedHaskellValue :: a -> IO RValue embedHaskellValue v = do intptr <- fmap (fromIntegral . ptrToIntPtr . castStablePtrToPtr) (newStablePtr v) :: IO Integer@@ -168,10 +159,10 @@ -- `embedHaskellValue`. freeHaskellValue :: RValue -> IO () freeHaskellValue v = do- intptr <- fromRuby v :: IO (Maybe Integer)+ intptr <- fromRuby v :: IO (Either String Integer) case intptr of- Just i -> freeStablePtr (castPtrToStablePtr (intPtrToPtr (fromIntegral i)))- Nothing -> error "Could not decode embedded value during free!"+ Right i -> freeStablePtr (castPtrToStablePtr (intPtrToPtr (fromIntegral i)))+ Left rr -> error ("Could not decode embedded value during free! " ++ rr) -- | This is unsafe as hell, so you'd better be certain this RValue has not -- been tempered with : GC frozen, bugfree Ruby scripts.@@ -180,10 +171,10 @@ -- a good vector for arbitrary code execution. extractHaskellValue :: RValue -> IO a extractHaskellValue v = do- intptr <- fromRuby v :: IO (Maybe Integer)+ intptr <- fromRuby v :: IO (Either String Integer) case intptr of- Just i -> deRefStablePtr (castPtrToStablePtr (intPtrToPtr (fromIntegral i)))- Nothing -> error "Could not decode embedded value!"+ Right i -> deRefStablePtr (castPtrToStablePtr (intPtrToPtr (fromIntegral i)))+ Left rr -> error ("Could not decode embedded value! " ++ rr) runscript :: String -> IO (Either String ()) runscript filename = do@@ -230,11 +221,11 @@ then return "Unknown runtime error" else do message <- rb_intern "message"- fmap (fromMaybe "undeserializable error") (rb_funcall runtimeerror message [] >>= fromRuby)+ fmap (either T.pack id) (rb_funcall runtimeerror message [] >>= fromRuby) rbt <- rb_gv_get "$@" bt <- if rbt == rbNil then return []- else fmap (fromMaybe []) (fromRuby rbt)+ else fmap (either (const []) id) (fromRuby rbt) return (T.unpack (T.unlines (m : bt))) -- | Sets the current GC operation. Please note that this could be modified
Foreign/Ruby/Safe.hs view
@@ -6,6 +6,7 @@ ( -- * Initialization and finalization startRubyInterpreter , closeRubyInterpreter+ , withRubyInterpreter -- * Data types , RubyError(..) , RValue@@ -15,6 +16,9 @@ , embedHaskellValue , safeMethodCall , makeSafe+ , fromRuby+ , toRuby+ , freezeGC -- * Wrapping Haskell function and registering them , RubyFunction1 , RubyFunction2@@ -29,8 +33,10 @@ ) where import Foreign hiding (void)-import qualified Foreign.Ruby as FR+import qualified Foreign.Ruby.Helpers as FR+import Control.Applicative import Control.Concurrent+import Control.Exception.Base import Control.Concurrent.STM import Control.Monad import Foreign.Ruby.Bindings@@ -46,11 +52,12 @@ | RegisterGlobalFunction5 !String !RubyFunction5 !NoOutput | MakeSafe !(IO ()) !NoOutput -data RubyError = Stack !String !String- | WithOutput !String !RValue+data RubyError = Stack String String+ | WithOutput String RValue+ | OtherError String deriving Show --- | This is acutally a newtype around a 'TQueue'.+-- | This is actually a newtype around a 'TQueue'. newtype RubyInterpreter = RubyInterpreter (TQueue IMessage) -- | All those function types can be used to register functions to the Ruby@@ -89,14 +96,21 @@ makeSafe int a = do -- the IO a computation is embedded in an IO () computation, so that -- all is type safe- mv <- newEmptyTMVarIO- let embedded = a >>= atomically . putTMVar mv+ mv <- newEmptyMVar+ let embedded = a >>= putMVar mv msg <- runMessage_ int (MakeSafe embedded) case msg of- Right _ -> Right `fmap` atomically (readTMVar mv)+ Right _ -> Right <$> takeMVar mv Left rr -> return (Left rr) --- | A safe version of the corresponding "Foreign.Ruby" function.+-- | 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 :: RubyInterpreter -> a -> IO (Either RubyError RValue) embedHaskellValue int v = makeSafe int $ FR.embedHaskellValue v @@ -117,35 +131,41 @@ runMessage_ (RubyInterpreter q) pm = do o <- newEmptyTMVarIO atomically (writeTQueue q (pm o))- atomically (readTMVar o) >>= \case- Nothing -> return (Right ())- Just r -> return (Left r)+ maybe (Right ()) Left <$> atomically (readTMVar o) -- | Initializes a Ruby interpreter. This should only be called once. It -- actually runs an internal server in a dedicated OS thread. startRubyInterpreter :: IO RubyInterpreter startRubyInterpreter = do q <- newTQueueIO- void $ forkOS (FR.initialize >> go q)+ void $ forkOS (ruby_init >> ruby_init_loadpath >> go q) return (RubyInterpreter q) +{-| This is basically :++> bracket startRubyInterpreter closeRubyInterpreter+-}+withRubyInterpreter :: (RubyInterpreter -> IO a) -> IO a+withRubyInterpreter = bracket startRubyInterpreter closeRubyInterpreter+ go :: TQueue IMessage -> IO () go q = do let continue = return False stop = return True runNoOutput :: NoOutput -> IO () -> IO Bool runNoOutput no a = do- a -- TODO catch exceptions- atomically $ putTMVar no Nothing+ try a >>= atomically . putTMVar no . either (\e -> Just $ OtherError $ show (e :: SomeException))+ (const Nothing) continue runReturns0 :: NoOutput -> IO Int -> String -> IO Bool runReturns0 no a errmsg = do- s <- a -- TODO catch exceptions- if s == 0- then atomically (putTMVar no Nothing)- else do+ s <- try a+ case s of+ Right 0 -> atomically (putTMVar no Nothing)+ Right _ -> do stack <- FR.showErrorStack atomically $ putTMVar no $ Just $ Stack errmsg stack+ Left e -> atomically $ putTMVar no $ Just $ OtherError $ show (e :: SomeException) continue finished <- atomically (readTQueue q) >>= \case@@ -158,10 +178,22 @@ RegisterGlobalFunction5 fname f no -> runNoOutput no $ mkRegisteredRubyFunction5 f >>= \rf -> rb_define_global_function fname rf 4 MakeSafe a no -> runNoOutput no a if finished- then FR.finalize+ then ruby_finalize else go q -- | This will shut the internal server down. closeRubyInterpreter :: RubyInterpreter -> IO () closeRubyInterpreter (RubyInterpreter q) = atomically (writeTQueue q MsgStop) +-- | Converts a Ruby value to some Haskell type..+fromRuby :: FR.FromRuby a => RubyInterpreter -> RValue -> IO (Either RubyError a)+fromRuby ri rv = either Left (either (Left . OtherError) Right) <$> makeSafe ri (FR.fromRuby rv)++-- | Insert a value in the Ruby runtime. You must always use such+-- a function and the resulting RValue ina 'freezeGC' call.+toRuby :: FR.ToRuby a => RubyInterpreter -> a -> IO (Either RubyError RValue)+toRuby ri = makeSafe ri . FR.toRuby++-- | Runs a computation with the Ruby GC disabled. Once the computation is over, GC will be re-enabled and the `startGC` function run.+freezeGC :: RubyInterpreter -> IO a -> IO a+freezeGC ri c = makeSafe ri (FR.setGC False) *> c <* makeSafe ri (FR.setGC True >> FR.startGC)
hruby.cabal view
@@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/ name: hruby-version: 0.2.9+version: 0.3.0 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@@ -22,6 +22,7 @@ library exposed-modules: Foreign.Ruby, Foreign.Ruby.Bindings, Foreign.Ruby.Helpers, Foreign.Ruby.Safe ghc-options: -Wall+ ghc-prof-options: -caf-all -auto-all extensions: BangPatterns, OverloadedStrings build-depends: base >= 4.6 && < 4.8 , aeson >= 0.7 && < 0.9@@ -40,6 +41,7 @@ hs-source-dirs: test type: exitcode-stdio-1.0 ghc-options: -Wall -threaded+ ghc-prof-options: -caf-all -auto-all extensions: OverloadedStrings build-depends: base >= 4.6 && < 4.8,hruby,aeson,QuickCheck,text,attoparsec,vector main-is: roundtrip.hs
test/roundtrip.hs view
@@ -1,19 +1,13 @@ module Main where -import Foreign.Ruby.Helpers(toRuby,fromRuby,freezeGC)-import Foreign.Ruby.Bindings-import Foreign.Ruby.Safe+import Foreign.Ruby 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)] @@ -38,33 +32,26 @@ v <- listOf subvalue return (zip k v) -instance Arbitrary Value where- arbitrary = frequency [(1,s),(5,a),(1,b),(1,n),(5,h)]+avalue :: Gen Value+avalue = frequency [(1,s),(5,a),(1,b),(1,n),(5,h)] roundTrip :: RubyInterpreter -> Property roundTrip i = monadicIO $ do- v <- pick (arbitrary :: Gen Value)- ex <- run $ freezeGC $ do- rub <- makeSafe i (toRuby v) >>= \r -> case r of- Right r' -> return r'- Left rr -> error (show rr)+ v <- pick avalue+ ex <- run $ freezeGC i $ do+ rub <- toRuby i v >>= either (error . show) return nxt <- safeMethodCall i "TestClass" "testfunc" [rub] case nxt of Right x -> do- out <- makeSafe i (fromRuby x) >>= \r -> case r of- Right r' -> return r'- Left rr -> error (show rr)- when (out /= Just v) (print out)- return (Just v == out)+ out <- fromRuby i x >>= \r -> case r of+ Right r' -> return r'+ Left rr -> error (show rr)+ when (out /= v) (print out)+ return (v == out) Left rr -> print rr >> return False assert ex main :: IO ()-main = do- i <- startRubyInterpreter- putStrLn "loading"- loadFile i "./test/test.rb" >>= \o -> case o of- Right () -> return ()- Left rr -> error (show rr)+main = withRubyInterpreter $ \i -> do+ loadFile i "./test/test.rb" >>= either (error . show) return quickCheckWith (stdArgs { maxSuccess = 1000 } ) (roundTrip i)- closeRubyInterpreter i