diff --git a/Foreign/Ruby/Bindings.hsc b/Foreign/Ruby/Bindings.hsc --- a/Foreign/Ruby/Bindings.hsc +++ b/Foreign/Ruby/Bindings.hsc @@ -17,7 +17,7 @@ data ShimDispatch = ShimDispatch RValue RID [RValue] instance Storable ShimDispatch where sizeOf _ = (#size struct s_dispatch) - alignment = sizeOf + alignment _ = (#alignment struct s_dispatch) peek ptr = do a <- peek ((#ptr struct s_dispatch, receiver) ptr) b <- peek ((#ptr struct s_dispatch, methodid) ptr) return (ShimDispatch a b []) @@ -79,6 +79,7 @@ foreign import ccall "ruby_finalize" ruby_finalize :: IO () foreign import ccall "ruby_initialization" ruby_initialization :: IO () +foreign import ccall "rb_str_new" c_rb_str_new :: CString -> CLong -> IO RValue foreign import ccall "rb_str_new_cstr" c_rb_str_new2 :: CString -> IO RValue foreign import ccall "rb_ary_new_capa" rb_ary_new2 :: CLong -> IO RValue foreign import ccall "rb_ary_new_from_values" rb_ary_new4 :: CLong -> Ptr RValue -> IO RValue @@ -133,30 +134,32 @@ rbUndef = intPtrToPtr 0x34 rtype :: RValue -> IO RType -rtype v = rubyType v >>= \x -> case x of - (#const RUBY_T_NONE) -> return RUndef - (#const RUBY_T_OBJECT) -> return (RBuiltin ROBJECT) - (#const RUBY_T_CLASS) -> return (RBuiltin RCLASS) - (#const RUBY_T_MODULE) -> return (RBuiltin RMODULE) - (#const RUBY_T_FLOAT) -> return (RBuiltin RFLOAT) - (#const RUBY_T_STRING) -> return (RBuiltin RSTRING) - (#const RUBY_T_REGEXP) -> return (RBuiltin RREGEXP) - (#const RUBY_T_ARRAY) -> return (RBuiltin RARRAY) - (#const RUBY_T_HASH) -> return (RBuiltin RHASH) - (#const RUBY_T_STRUCT) -> return (RBuiltin RSTRUCT) - (#const RUBY_T_BIGNUM) -> return (RBuiltin RBIGNUM) - (#const RUBY_T_FILE) -> return (RBuiltin RFILE) - (#const RUBY_T_DATA) -> return (RBuiltin RDATA) - (#const RUBY_T_MATCH) -> return (RBuiltin RMATCH) - (#const RUBY_T_NIL) -> return RNil - (#const RUBY_T_TRUE) -> return RTrue - (#const RUBY_T_FALSE) -> return RFalse - (#const RUBY_T_SYMBOL) -> return RSymbol - (#const RUBY_T_FIXNUM) -> return RFixNum - (#const RUBY_T_UNDEF) -> return (RBuiltin RUNDEF) - (#const RUBY_T_NODE) -> return (RBuiltin RNODE) - (#const RUBY_T_ICLASS) -> return (RBuiltin RICLASS) - _ -> return RUndef +rtype v = cnv <$> rubyType v + where + cnv x = case x of + (#const RUBY_T_NONE) -> RUndef + (#const RUBY_T_OBJECT) -> RBuiltin ROBJECT + (#const RUBY_T_CLASS) -> RBuiltin RCLASS + (#const RUBY_T_MODULE) -> RBuiltin RMODULE + (#const RUBY_T_FLOAT) -> RBuiltin RFLOAT + (#const RUBY_T_STRING) -> RBuiltin RSTRING + (#const RUBY_T_REGEXP) -> RBuiltin RREGEXP + (#const RUBY_T_ARRAY) -> RBuiltin RARRAY + (#const RUBY_T_HASH) -> RBuiltin RHASH + (#const RUBY_T_STRUCT) -> RBuiltin RSTRUCT + (#const RUBY_T_BIGNUM) -> RBuiltin RBIGNUM + (#const RUBY_T_FILE) -> RBuiltin RFILE + (#const RUBY_T_DATA) -> RBuiltin RDATA + (#const RUBY_T_MATCH) -> RBuiltin RMATCH + (#const RUBY_T_NIL) -> RNil + (#const RUBY_T_TRUE) -> RTrue + (#const RUBY_T_FALSE) -> RFalse + (#const RUBY_T_SYMBOL) -> RSymbol + (#const RUBY_T_FIXNUM) -> RFixNum + (#const RUBY_T_UNDEF) -> RBuiltin RUNDEF + (#const RUBY_T_NODE) -> RBuiltin RNODE + (#const RUBY_T_ICLASS) -> RBuiltin RICLASS + _ -> RUndef rb_string_value_cstr :: RValue -> IO String rb_string_value_cstr v = do @@ -200,7 +203,7 @@ 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_str_new2 str = withCStringLen str (\(x, ln) -> c_rb_str_new x (fromIntegral ln)) rb_define_module :: String -> IO () rb_define_module str = withCString str c_rb_define_module diff --git a/Foreign/Ruby/Helpers.hs b/Foreign/Ruby/Helpers.hs --- a/Foreign/Ruby/Helpers.hs +++ b/Foreign/Ruby/Helpers.hs @@ -67,7 +67,7 @@ _ -> return (Left ("Expected a string, not " ++ show t)) instance ToRuby BS.ByteString where - toRuby s = BS.useAsCString s c_rb_str_new2 + toRuby s = BS.useAsCStringLen s (\(x, ln) -> c_rb_str_new x (fromIntegral ln)) instance FromRuby T.Text where fromRuby = fmap (fmap T.decodeUtf8) . fromRuby @@ -138,7 +138,7 @@ rb_hash_foreach v wappender rbNil freeHaskellFunPtr wappender fmap (Right . toHash) (readIORef var) - _ -> return $ Left ("Could not decode: " ++ show t) + _ -> return $ Left ("Could not decode value: " ++ show t) instance ToRuby Scientific where toRuby s @@ -147,9 +147,7 @@ instance ToRuby Value where toRuby (Number x) = toRuby x - toRuby (String t) = - let bs = T.encodeUtf8 t - in BS.useAsCString bs c_rb_str_new2 + toRuby (String t) = toRuby t toRuby Null = return rbNil toRuby (Bool True) = return rbTrue toRuby (Bool False) = return rbFalse diff --git a/cbits/shim.c b/cbits/shim.c --- a/cbits/shim.c +++ b/cbits/shim.c @@ -9,9 +9,12 @@ rb_enc_set_default_internal(encoding); rb_enc_set_default_external(encoding); void rb_encdb_declare(const char *name); + int rb_encdb_alias(const char *alias, const char *orig); rb_encdb_declare("ASCII-8BIT"); rb_encdb_declare("US-ASCII"); rb_encdb_declare("UTF-8"); + rb_encdb_alias("BINARY", "ASCII-8BIT"); + rb_encdb_alias("ASCII", "US-ASCII"); } VALUE id2sym(ID i) { diff --git a/hruby.cabal b/hruby.cabal --- a/hruby.cabal +++ b/hruby.cabal @@ -1,6 +1,6 @@ cabal-version: >= 1.10 name: hruby -version: 0.5.0.0 +version: 0.5.1.0 synopsis: Embed a Ruby intepreter in your Haskell program ! description: This works with Ruby 2.2+. Everything you need should be in Foreign.Ruby.Safe. license: BSD3 @@ -12,9 +12,6 @@ build-type: Custom extra-source-files: test/*.rb Tested-With: GHC == 8.8.1, GHC == 8.10.2, GHC == 9.0.1 - -custom-setup - setup-depends: Cabal, base, process source-repository head type: git diff --git a/test/roundtrip.hs b/test/roundtrip.hs --- a/test/roundtrip.hs +++ b/test/roundtrip.hs @@ -1,14 +1,34 @@ module Main where -import Control.Monad -import Data.Aeson +import Control.Monad (unless, when) +import Data.Aeson (Value (Array, Bool, Number, String), object) import Data.Aeson.Key (fromText) import qualified Data.Text as T import qualified Data.Vector as V -import Foreign.Ruby +import Foreign.Ruby.Safe + ( RubyInterpreter, + freezeGC, + fromRuby, + loadFile, + safeMethodCall, + toRuby, + withRubyInterpreter, + ) import System.Exit (exitFailure) import Test.QuickCheck -import Test.QuickCheck.Monadic + ( Arbitrary (arbitrary), + Args (maxSuccess), + Gen, + Property, + elements, + frequency, + isSuccess, + listOf, + quickCheckWithResult, + resize, + stdArgs, + ) +import Test.QuickCheck.Monadic (assert, monadicIO, pick, run) subvalue :: Gen Value subvalue = frequency [(50, s), (20, b), (20, n), (1, h), (1, a)]