diff --git a/luka.cabal b/luka.cabal --- a/luka.cabal +++ b/luka.cabal @@ -1,5 +1,5 @@ Name: luka -Version: 2012.7.7 +Version: 2012.7.7.1 Build-type: Simple Synopsis: Simple ObjectiveC runtime binding Description: Simple ObjectiveC runtime binding diff --git a/readme.md b/readme.md --- a/readme.md +++ b/readme.md @@ -1,3 +1,6 @@ +Luka +==== + Simple ObjectiveC runtime binding Tutorial @@ -16,6 +19,11 @@ nemesis run + +Notes +==== + +* when used with `ghci`, `-frameworkCocoa` flag is required License: ======== diff --git a/src/Init.hs b/src/Init.hs --- a/src/Init.hs +++ b/src/Init.hs @@ -2,21 +2,12 @@ module Init where -import Foreign hiding (void) -import Foreign.C.Types -import Foreign.C.String - -import Prelude () -import Air.Env -import Control.Monad ((>=>)) - import Language.ObjectiveC.Luka.RunTime import Language.ObjectiveC.Luka -import Foreign.LibFFI + main = do - with_pool - do + with_pool $ do ns_puts "Hello World!" [] - -- c_NSApplicationMain 0 nullPtr diff --git a/src/Language/ObjectiveC/Luka/API.hs b/src/Language/ObjectiveC/Luka/API.hs --- a/src/Language/ObjectiveC/Luka/API.hs +++ b/src/Language/ObjectiveC/Luka/API.hs @@ -22,56 +22,19 @@ from_ns_string :: ID -> IO String -from_ns_string = msg_cstring "UTF8String" [] >=> peekCString - - +from_ns_string = msg "UTF8String" [] retCString >=> peekCString with_pool :: IO a -> IO () with_pool _io = do - pool <- class_named "NSAutoreleasePool" >>= msg_obj "alloc" [] >>= msg_obj "init" [] + pool <- class_named "NSAutoreleasePool" >>= msg "alloc" [] retId >>= msg "init" [] retId _io - pool .msg "release" [] + pool .msg "release" [] retVoid -msg :: String -> [Arg] -> ID -> IO () -msg methodName args obj = sel_named methodName >>= \sel -> objc_msgSend_void obj sel args - -msg_ptr :: String -> [Arg] -> ID -> IO (Ptr ()) -msg_ptr methodName args obj = sel_named methodName >>= \sel -> objc_msgSend_ptr obj sel args - -msg_obj :: String -> [Arg] -> ID -> IO ID -msg_obj methodName args obj = sel_named methodName >>= \sel -> objc_msgSend_obj obj sel args - -msg_cint :: String -> [Arg] -> ID -> IO CInt -msg_cint methodName args obj = sel_named methodName >>= \sel -> objc_msgSend_cint obj sel args - -msg_cuint :: String -> [Arg] -> ID -> IO CUInt -msg_cuint methodName args obj = sel_named methodName >>= \sel -> objc_msgSend_cuint obj sel args - -msg_clong :: String -> [Arg] -> ID -> IO CLong -msg_clong methodName args obj = sel_named methodName >>= \sel -> objc_msgSend_clong obj sel args - -msg_culong :: String -> [Arg] -> ID -> IO CULong -msg_culong methodName args obj = sel_named methodName >>= \sel -> objc_msgSend_culong obj sel args - -msg_cfloat :: String -> [Arg] -> ID -> IO CFloat -msg_cfloat methodName args obj = sel_named methodName >>= \sel -> objc_msgSend_cfloat obj sel args - -msg_cdouble :: String -> [Arg] -> ID -> IO CDouble -msg_cdouble methodName args obj = sel_named methodName >>= \sel -> objc_msgSend_cdouble obj sel args - -msg_cchar :: String -> [Arg] -> ID -> IO CChar -msg_cchar methodName args obj = sel_named methodName >>= \sel -> objc_msgSend_cchar obj sel args - -msg_uchar :: String -> [Arg] -> ID -> IO CUChar -msg_uchar methodName args obj = sel_named methodName >>= \sel -> objc_msgSend_cuchar obj sel args - -msg_cstring :: String -> [Arg] -> ID -> IO CString -msg_cstring methodName args obj = sel_named methodName >>= \sel -> objc_msgSend_cstring obj sel args - - +msg :: String -> [Arg] -> RetType a -> ID -> IO a +msg methodName args ret_type obj = sel_named methodName >>= \sel -> objc_msgSend obj sel args ret_type sel_named :: String -> IO SEL sel_named = sel_getUid @@ -79,7 +42,7 @@ ns_string :: String -> IO ID ns_string x = do - class_named "NSString" >>= msg_obj "stringWithUTF8String:" [argString x] + class_named "NSString" >>= msg "stringWithUTF8String:" [argString x] retId class_named :: String -> IO ID @@ -98,4 +61,3 @@ method <- class_getInstanceMethod class_pointer cmd method_setImplementation method method_implementation - diff --git a/src/Language/ObjectiveC/Luka/RunTime.hs b/src/Language/ObjectiveC/Luka/RunTime.hs --- a/src/Language/ObjectiveC/Luka/RunTime.hs +++ b/src/Language/ObjectiveC/Luka/RunTime.hs @@ -41,8 +41,8 @@ data SELData type SEL = Ptr SELData -data IVarData -type IVar = Ptr IVarData +data IvarData +type Ivar = Ptr IvarData objc_False :: CChar objc_False = 0x0 @@ -55,49 +55,49 @@ -retIdPtr :: RetType ID -retIdPtr = fmap castPtr $ retPtr retVoid +retId :: RetType ID +retId = fmap castPtr $ retPtr retVoid -retSelPtr :: RetType SEL -retSelPtr = fmap castPtr $ retPtr retVoid +retSel :: RetType SEL +retSel = fmap castPtr $ retPtr retVoid -retIVarPtr :: RetType IVar -retIVarPtr = fmap castPtr $ retPtr retVoid +retIvar :: RetType Ivar +retIvar = 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_getInstanceVariable :: ID -> String -> IO Ivar +object_getInstanceVariable objectPtr instanceName = callFFI funPtr_object_getInstanceVariable retIvar [argPtr objectPtr, argString instanceName] -object_getIvar :: ID -> IVar -> IO ID -object_getIvar objectPtr ivarPtr = callFFI funPtr_object_getIvar retIdPtr [argPtr objectPtr, argPtr ivarPtr] +object_getIvar :: ID -> Ivar -> IO ID +object_getIvar objectPtr ivarPtr = callFFI funPtr_object_getIvar retId [argPtr objectPtr, argPtr ivarPtr] objc_getClass :: String -> IO ID -objc_getClass className = callFFI funPtr_objc_getClass retIdPtr [argString className] +objc_getClass className = callFFI funPtr_objc_getClass retId [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_registerName methodName = callFFI funPtr_sel_registerName retSel [argString methodName] sel_getUid :: String -> IO SEL -sel_getUid methodName = callFFI funPtr_sel_getUid retSelPtr [argString methodName] +sel_getUid methodName = callFFI funPtr_sel_getUid retSel [argString methodName] class_createInstance :: ID -> IO ID -class_createInstance classPtr = callFFI funPtr_class_createInstance retIdPtr [argPtr classPtr, argCSize 0] +class_createInstance classPtr = callFFI funPtr_class_createInstance retId [argPtr classPtr, argCSize 0] object_dispose :: ID -> IO ID -object_dispose objectPtr = callFFI funPtr_object_dispose retIdPtr [argPtr objectPtr] +object_dispose objectPtr = callFFI funPtr_object_dispose retId [argPtr objectPtr] objc_allocateClassPair :: ID -> String -> IO ID -objc_allocateClassPair super name = callFFI funPtr_objc_allocateClassPair retIdPtr [argPtr super, argString name, argCSize 0] +objc_allocateClassPair super name = callFFI funPtr_objc_allocateClassPair retId [argPtr super, argString name, argCSize 0] objc_registerClassPair :: ID -> IO () objc_registerClassPair classPtr = callFFI funPtr_objc_registerClassPair retVoid [argPtr classPtr] @@ -110,102 +110,7 @@ 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 +class_getInstanceMethod classPtr selectorPtr = callFFI funPtr_class_getInstanceMethod retId [argPtr classPtr, argPtr selectorPtr] -retCString :: RetType CString -retCString = retPtr retCChar --} +objc_msgSend :: ID -> SEL -> [Arg] -> RetType a -> IO a +objc_msgSend objectPtr selPtr args retType = callFFI funPtr_objc_msgSend retType (argPtr objectPtr : argPtr selPtr : args)