{-# 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

type BOOL = CChar

objc_False :: BOOL
objc_False = 0x0

objc_True :: BOOL
objc_True = 0x1

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



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

retSel :: RetType SEL
retSel = 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 retIvar [argPtr objectPtr, argString instanceName]

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 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 retSel [argString methodName]

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


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

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


objc_allocateClassPair :: ID -> String -> IO ID
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]

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 retId [argPtr classPtr, argPtr selectorPtr]

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)