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



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 "UTF8String" [] retCString >=> peekCString

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


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


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


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

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