{-# LANGUAGE ForeignFunctionInterface, TypeSynonymInstances #-} {- TODO Rip the array trnaslation stuff out to a utility function. same with hashes. install as package. This is a bit iffy for GHC/JHC compatibility - if we commit to Cabal, that leaves JHC out in the cold. perhaps need cabal file for ghc and equivalent for jhc. also: do we want to support different versions of ruby? for the moment, you just get whichever ruby.h is first in the search place. -} module Language.Ruby.Hubris.Binding where #include "rshim.h" #include -- import Control.Applicative -- import Control.Monad import Data.Word -- import Foreign.Ptr import Foreign.C.Types import Foreign.C.String -- import Foreign.Storable import System.IO.Unsafe (unsafePerformIO) -- import Foreign.Marshal.Array {# context lib="rshim" #} {# enum RubyType {} deriving (Eq, Show) #} -- maybe Ord? #if RUBY_VERSION_CODE <= 187 data RubyConsts = RUBY_Qfalse | RUBY_Qtrue | RUBY_Qnil | RUBY_Qundef instance Enum RubyConsts where fromEnum RUBY_Qfalse = 0 fromEnum RUBY_Qtrue = 2 fromEnum RUBY_Qnil = 4 fromEnum RUBY_Qundef = 6 toEnum 0 = RUBY_Qfalse toEnum 2 = RUBY_Qtrue toEnum 4 = RUBY_Qnil toEnum 6 = RUBY_Qundef #else {# enum ruby_special_consts as RubyConsts {} deriving (Eq,Show) #} #endif type Value = CULong -- FIXME, we'd prefer to import the type VALUE directly foreign import ccall unsafe "ruby.h rb_str2cstr" rb_str2cstr :: Value -> CInt -> CString foreign import ccall unsafe "ruby.h rb_str_new2" rb_str_new2 :: CString -> Value foreign import ccall unsafe "ruby.h rb_ary_new2" rb_ary_new2 :: CLong -> IO Value foreign import ccall unsafe "ruby.h rb_ary_push" rb_ary_push :: Value -> Value -> IO () foreign import ccall unsafe "ruby.h rb_float_new" rb_float_new :: Double -> Value foreign import ccall unsafe "ruby.h rb_big2str" rb_big2str :: Value -> Int -> Value foreign import ccall unsafe "ruby.h rb_str_to_inum" rb_str_to_inum :: Value -> Int -> Int -> Value foreign import ccall unsafe "ruby.h ruby_init" ruby_init :: IO () -- we're being a bit filthy here - the interface is all macros, so we're digging in to find what it actually is foreign import ccall unsafe "rshim.h rb_ary_len" rb_ary_len :: Value -> CUInt foreign import ccall unsafe "rshim.h rtype" rtype :: Value -> Int foreign import ccall unsafe "rshim.h int2fix" int2fix :: Int -> Value foreign import ccall unsafe "rshim.h fix2int" fix2int :: Value -> Int foreign import ccall unsafe "rshim.h num2dbl" num2dbl :: Value -> Double -- technically CDoubles, but jhc promises they're the same foreign import ccall unsafe "rshim.h keys" rb_keys :: Value -> IO Value -- this line crashes jhc foreign import ccall unsafe "intern.h rb_ary_entry" rb_ary_entry :: Value -> CLong -> IO Value foreign import ccall safe "ruby.h rb_raise" rb_raise :: Value -> CString -> IO () foreign import ccall unsafe "ruby.h rb_eval_string" rb_eval_string :: CString -> Value foreign import ccall unsafe "intern.h rb_hash_aset" rb_hash_aset :: Value -> Value -> Value -> IO () foreign import ccall unsafe "intern.h rb_hash_new" rb_hash_new :: IO Value foreign import ccall unsafe "intern.h rb_hash_aref" rb_hash_aref :: Value -> Value -> IO Value data RValue = T_NIL | T_FLOAT Double | T_STRING String -- List is non-ideal. Switch to uvector? Array? There's always going -- to be an extraction step to pull the RValues out. | T_ARRAY [RValue] | T_FIXNUM Int | T_HASH Value -- Int -- definitely FIXME - native ruby hashes, or going to transliterate into Data.Map? | T_BIGNUM Integer -- technically, these are mapping over the types True and False, -- I'm going to treat them as values, though. | T_TRUE | T_FALSE | T_SYMBOL Word -- interned string deriving (Eq, Show) -- These are the other basic Ruby structures that we're not handling yet. -- | T_REGEXP -- | T_FILE -- | T_STRUCT -- | T_DATA -- | T_OBJECT -- | T_CLASS -- | T_MODULE -- leaky as hell fromRVal :: RValue -> Value fromRVal r = case r of T_FLOAT d -> rb_float_new d -- need to take the address of the cstr, just cast it to a value -- sadly no bytestrings yet - unpack it to a list. yeah it's ugly. T_STRING str -> rb_str_new2 $ unsafePerformIO $ newCAString str T_FIXNUM i -> int2fix i -- so this is just bizarre - there's no boolean type. True and False have their own types -- as well as their own values. T_TRUE -> fromIntegral $ fromEnum RUBY_Qtrue T_FALSE -> fromIntegral $ fromEnum RUBY_Qfalse T_NIL -> fromIntegral $ fromEnum RUBY_Qnil T_HASH h -> h T_ARRAY l -> unsafePerformIO $ do ary <- rb_ary_new2 $ fromIntegral $ length l mapM_ (rb_ary_push ary . fromRVal) l return ary T_BIGNUM b -> rb_str_to_inum (rb_str_new2 $ unsafePerformIO $ newCAString $ show b) 10 1 _ -> error "sorry, haven't implemented that yet." fromVal :: Value -> RValue fromVal v = case target of RT_NIL -> T_NIL RT_FIXNUM -> T_FIXNUM $ fix2int v RT_STRING -> T_STRING $ unsafePerformIO $ peekCString $ rb_str2cstr v 0 RT_FLOAT -> T_FLOAT $ num2dbl v RT_BIGNUM -> T_BIGNUM $ read $ unsafePerformIO $ peekCString $ rb_str2cstr (rb_big2str v 10) 0 RT_TRUE -> T_TRUE RT_FALSE -> T_FALSE RT_HASH -> T_HASH v RT_ARRAY -> T_ARRAY $ map fromVal $ unsafePerformIO $ mapM (rb_ary_entry v . fromIntegral) [0..(rb_ary_len v) - 1] _ -> error "didn't work" -- (show target) where target :: RubyType target = toEnum $ rtype v unsafeThrow :: String -> a unsafeThrow s = unsafePerformIO $ throwException s >> undefined throwException :: String -> IO Value throwException s = do he <- newCAString "HaskellError" err <- newCAString s rb_raise (rb_eval_string he) err error "shouldn't ever get here"