RunTime.hs

{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE EmptyDataDecls #-}
 

module Language.ObjectiveC.Luka.RunTime where

import Foreign
import Foreign.C.Types
import Foreign.C.String
import Foreign.LibFFI



foreign import ccall safe "&object_getInstanceVariable"   funPtr_object_getInstanceVariable :: FunPtr ()
foreign import ccall safe "&object_getIvar"               funPtr_object_getIvar             :: FunPtr ()
foreign import ccall safe "&objc_getClass"                funPtr_objc_getClass              :: FunPtr ()
foreign import ccall safe "&method_setImplementation"     funPtr_method_setImplementation   :: FunPtr ()
foreign import ccall safe "&objc_msgSend"                 funPtr_objc_msgSend               :: FunPtr ()
foreign import ccall safe "&sel_registerName"             funPtr_sel_registerName           :: FunPtr ()
foreign import ccall safe "&sel_getUid"                   funPtr_sel_getUid                 :: FunPtr ()
foreign import ccall safe "&class_createInstance"         funPtr_class_createInstance       :: FunPtr ()
foreign import ccall safe "&object_dispose"               funPtr_object_dispose             :: FunPtr ()
foreign import ccall safe "&objc_allocateClassPair"       funPtr_objc_allocateClassPair     :: FunPtr ()
foreign import ccall safe "&objc_registerClassPair"       funPtr_objc_registerClassPair     :: FunPtr ()
foreign import ccall safe "&class_addMethod"              funPtr_class_addMethod            :: FunPtr ()
foreign import ccall safe "&class_getInstanceMethod"      funPtr_class_getInstanceMethod    :: FunPtr ()

foreign import ccall safe "&NSLog"                        funPtr_NSLog                      :: FunPtr ()


foreign import ccall safe "NSApplicationMain"             c_NSApplicationMain :: CInt -> Ptr (Ptr CChar) -> IO CInt
foreign import ccall safe "method_getTypeEncoding"        method_getTypeEncoding :: Ptr a -> IO CString





data IDData
type ID = Ptr IDData

data SELData
type SEL = Ptr SELData

data IVarData
type IVar = Ptr IVarData

objc_False :: CChar
objc_False = 0x0

objc_True :: CChar
objc_True = 0x1

c2b :: CChar -> Bool
c2b = (== 0x1)



retIdPtr :: RetType ID
retIdPtr = fmap castPtr $ retPtr retVoid

retSelPtr :: RetType SEL
retSelPtr = fmap castPtr $ retPtr retVoid

retIVarPtr :: RetType IVar
retIVarPtr = fmap castPtr $ retPtr retVoid

retVoidPtr :: RetType (Ptr ())
retVoidPtr = fmap castPtr $ retPtr retVoid


object_getInstanceVariable :: ID -> String -> IO IVar
object_getInstanceVariable objectPtr instanceName = callFFI funPtr_object_getInstanceVariable retIVarPtr [argPtr objectPtr, argString instanceName]

object_getIvar :: ID -> IVar -> IO ID
object_getIvar objectPtr ivarPtr = callFFI funPtr_object_getIvar retIdPtr [argPtr objectPtr, argPtr ivarPtr]


objc_getClass :: String -> IO ID
objc_getClass className = callFFI funPtr_objc_getClass retIdPtr [argString className]

method_setImplementation :: Ptr a -> FunPtr b -> IO (FunPtr ())
method_setImplementation methodPtr funPtr = callFFI funPtr_method_setImplementation (retFunPtr retVoid) [argPtr methodPtr, argFunPtr funPtr]


sel_registerName :: String -> IO SEL
sel_registerName methodName = callFFI funPtr_sel_registerName retSelPtr [argString methodName]

sel_getUid :: String -> IO SEL
sel_getUid methodName = callFFI funPtr_sel_getUid retSelPtr [argString methodName]


class_createInstance :: ID -> IO ID
class_createInstance classPtr = callFFI funPtr_class_createInstance retIdPtr [argPtr classPtr, argCSize 0]

object_dispose :: ID -> IO ID
object_dispose objectPtr = callFFI funPtr_object_dispose retIdPtr [argPtr objectPtr]


objc_allocateClassPair :: ID -> String -> IO ID
objc_allocateClassPair super name = callFFI funPtr_objc_allocateClassPair retIdPtr [argPtr super, argString name, argCSize 0]

objc_registerClassPair :: ID -> IO ()
objc_registerClassPair classPtr = callFFI funPtr_objc_registerClassPair retVoid [argPtr classPtr]

class_addMethod :: ID -> SEL -> FunPtr a -> String -> IO Bool
class_addMethod classPtr methodPtr methodImplPtr types = callFFI funPtr_class_addMethod (fmap c2b retCChar) [argPtr classPtr, argPtr methodPtr, argFunPtr methodImplPtr, argString types]

ns_log :: [Arg] -> IO ()
ns_log = callFFI funPtr_NSLog retVoid


class_getInstanceMethod :: Ptr a -> Ptr b -> IO ID
class_getInstanceMethod classPtr selectorPtr = callFFI funPtr_class_getInstanceMethod retIdPtr [argPtr classPtr, argPtr selectorPtr]


objc_msgSend_void :: ID -> SEL -> [Arg] -> IO ()
objc_msgSend_void objectPtr selPtr args = callFFI funPtr_objc_msgSend retVoid (argPtr objectPtr : argPtr selPtr : args)

objc_msgSend_ptr :: ID -> SEL -> [Arg] -> IO (Ptr ())
objc_msgSend_ptr objectPtr selPtr args = callFFI funPtr_objc_msgSend retVoidPtr (argPtr objectPtr : argPtr selPtr : args)

objc_msgSend_obj :: ID -> SEL -> [Arg] -> IO ID
objc_msgSend_obj objectPtr selPtr args = callFFI funPtr_objc_msgSend retIdPtr (argPtr objectPtr : argPtr selPtr : args)

objc_msgSend_cint :: ID -> SEL -> [Arg] -> IO CInt
objc_msgSend_cint objectPtr selPtr args = callFFI funPtr_objc_msgSend retCInt (argPtr objectPtr : argPtr selPtr : args)

objc_msgSend_cuint :: ID -> SEL -> [Arg] -> IO CUInt
objc_msgSend_cuint objectPtr selPtr args = callFFI funPtr_objc_msgSend retCUInt (argPtr objectPtr : argPtr selPtr : args)

objc_msgSend_clong :: ID -> SEL -> [Arg] -> IO CLong
objc_msgSend_clong objectPtr selPtr args = callFFI funPtr_objc_msgSend retCLong (argPtr objectPtr : argPtr selPtr : args)

objc_msgSend_culong :: ID -> SEL -> [Arg] -> IO CULong
objc_msgSend_culong objectPtr selPtr args = callFFI funPtr_objc_msgSend retCULong (argPtr objectPtr : argPtr selPtr : args)

objc_msgSend_cfloat :: ID -> SEL -> [Arg] -> IO CFloat
objc_msgSend_cfloat objectPtr selPtr args = callFFI funPtr_objc_msgSend retCFloat (argPtr objectPtr : argPtr selPtr : args)

objc_msgSend_cdouble :: ID -> SEL -> [Arg] -> IO CDouble
objc_msgSend_cdouble objectPtr selPtr args = callFFI funPtr_objc_msgSend retCDouble (argPtr objectPtr : argPtr selPtr : args)

objc_msgSend_cchar :: ID -> SEL -> [Arg] -> IO CChar
objc_msgSend_cchar objectPtr selPtr args = callFFI funPtr_objc_msgSend retCChar (argPtr objectPtr : argPtr selPtr : args)

objc_msgSend_cuchar :: ID -> SEL -> [Arg] -> IO CUChar
objc_msgSend_cuchar objectPtr selPtr args = callFFI funPtr_objc_msgSend retCUChar (argPtr objectPtr : argPtr selPtr : args)

objc_msgSend_cstring :: ID -> SEL -> [Arg] -> IO CString
objc_msgSend_cstring objectPtr selPtr args = callFFI funPtr_objc_msgSend retCString (argPtr objectPtr : argPtr selPtr : args)


{-
retCInt     :: RetType CInt
retCInt     = mkStorableRetType ffi_type_sint
retCUInt    :: RetType CUInt
retCUInt    = mkStorableRetType ffi_type_uint
retCLong    :: RetType CLong
retCLong    = mkStorableRetType ffi_type_slong
retCULong   :: RetType CULong
retCULong   = mkStorableRetType ffi_type_ulong

retInt      :: RetType Int
retInt      = mkStorableRetType ffi_type_hs_int
retInt8     :: RetType Int8
retInt8     = mkStorableRetType ffi_type_sint8
retInt16    :: RetType Int16
retInt16    = mkStorableRetType ffi_type_sint16
retInt32    :: RetType Int32
retInt32    = mkStorableRetType ffi_type_sint32
retInt64    :: RetType Int64
retInt64    = mkStorableRetType ffi_type_sint64

retWord     :: RetType Word
retWord     = mkStorableRetType ffi_type_hs_word
retWord8    :: RetType Word8
retWord8    = mkStorableRetType ffi_type_uint8
retWord16   :: RetType Word16
retWord16   = mkStorableRetType ffi_type_uint16
retWord32   :: RetType Word32
retWord32   = mkStorableRetType ffi_type_uint32
retWord64   :: RetType Word64
retWord64   = mkStorableRetType ffi_type_uint64

retCFloat   :: RetType CFloat
retCFloat   = mkStorableRetType ffi_type_float
retCDouble  :: RetType CDouble
retCDouble  = mkStorableRetType ffi_type_double

retCSize    :: RetType CSize
retCSize    = mkStorableRetType ffi_type_size
retCTime    :: RetType CTime
retCTime    = mkStorableRetType ffi_type_time

retCChar    :: RetType CChar
retCChar    = mkStorableRetType ffi_type_schar
retCUChar   :: RetType CUChar
retCUChar   = mkStorableRetType ffi_type_uchar

retCWchar   :: RetType CWchar
retCWchar   = mkStorableRetType ffi_type_schar

retFunPtr   :: RetType a -> RetType (FunPtr a)
retFunPtr _ = mkStorableRetType ffi_type_pointer

retPtr      :: RetType a -> RetType (Ptr a)
retPtr _    = mkStorableRetType ffi_type_pointer

retCString          :: RetType CString
retCString          = retPtr retCChar
-}