API.hs

{-# LANGUAGE ForeignFunctionInterface #-}
 
module Language.ObjectiveC.Luka.API 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 Foreign.LibFFI
import Data.ByteString (ByteString)

yes, no :: BOOL
yes = objc_True
no = objc_False

argYES = argCChar yes
argNO = argCChar no

nil :: ID
nil = nullPtr

get_i :: String -> ID -> IO ID
get_i ivar_name obj = do
    object_getInstanceVariable obj ivar_name >>= object_getIvar obj
      

from_ns_string :: ID -> IO String
from_ns_string = msg_string "UTF8String" []

with_pool :: IO a -> IO ()
with_pool _io = do
  pool <- class_named "NSAutoreleasePool" >>= msg "alloc" [] >>= msg "init" []
  
  _io
  
  void - pool .msg "release" []
  



sel_named :: String -> IO SEL
sel_named = sel_getUid


ns_string :: String -> IO ID
ns_string x = do
  class_named "NSString" >>= msg_obj "stringWithUTF8String:" [argString x]

with_ns_string :: String -> (ID -> IO a) -> IO a
with_ns_string x f = do
  _ns_string <- class_named "NSString" >>= msg "alloc" [] >>= msg_obj "initWithUTF8String:" [argString x]
  r <- f _ns_string
  _ns_string.msg "release" []
  
  return r

class_named :: String -> IO ID
class_named = objc_getClass

ns_puts :: String -> [Arg] -> IO ()
ns_puts x args = do
  ns_msg <- ns_string x
  ns_log - argPtr ns_msg : args

ns_puts' :: String -> IO ()
ns_puts' x = ns_puts x []

add_method :: String -> String -> FunPtr a -> String -> IO Bool
add_method class_name sel_name method_implementation method_type_encoding = do
  class_pointer <- class_named class_name
  sel_pointer <- sel_named sel_name

  class_addMethod class_pointer sel_pointer method_implementation method_type_encoding
  

  
set_method :: String -> String -> FunPtr a -> IO (FunPtr ())
set_method class_name sel_name method_implementation = do
  class_pointer <- class_named class_name
  sel_pointer <- sel_named sel_name
  
  method <- class_getInstanceMethod class_pointer sel_pointer
  
  method_setImplementation method method_implementation


msg_type :: RetType a -> String -> [Arg] -> ID -> IO a
msg_type ret_type methodName args obj = sel_named methodName >>= \sel -> objc_msgSend obj sel args ret_type

type MessageReturn a = String -> [Arg] -> ID -> IO a

msg :: String -> [ID] -> ID -> IO ID
msg methodName args = msg_obj methodName - args.map argPtr

msg_obj         :: MessageReturn ID
msg_obj         = msg_type retId

msg_void        :: MessageReturn () 
msg_void        = msg_type retVoid
                
msg_cint        :: MessageReturn CInt
msg_cint        = msg_type retCInt
                
msg_cuint       :: MessageReturn CUInt
msg_cuint       = msg_type retCUInt
                
msg_clong       :: MessageReturn CLong
msg_clong       = msg_type retCLong
                
msg_culong      :: MessageReturn CULong
msg_culong      = msg_type retCULong
                
msg_cfloat      :: MessageReturn CFloat
msg_cfloat      = msg_type retCFloat
                
msg_cdouble     :: MessageReturn CDouble
msg_cdouble     = msg_type retCDouble
                
msg_csize       :: MessageReturn CSize
msg_csize       = msg_type retCSize
                
msg_ctime       :: MessageReturn CTime
msg_ctime       = msg_type retCTime
                
msg_cchar       :: MessageReturn CChar
msg_cchar       = msg_type retCChar
                
msg_cuchar      :: MessageReturn CUChar
msg_cuchar      = msg_type retCUChar
                
msg_cwchar      :: MessageReturn CWchar
msg_cwchar      = msg_type retCWchar
                
msg_cstring     :: MessageReturn CString
msg_cstring     = msg_type retCString
                
msg_string      :: MessageReturn String
msg_string      = msg_type retString
                
msg_bytestring  :: MessageReturn ByteString
msg_bytestring  = msg_type retByteString