Refactor.

Author: dboris

CHANGES.md

@@ -2,8 +2,7 @@
 
 API changes:
 
-* `Property.value` is renamed to `Property.value_prop`,
-  `Property._object_` to `Property.obj_prop`
+* Replaced `Property.value` and `Property._object_` with a single `Property.define`.
 
 ## Release 0.2.2
 

camlkit/camlkit.ml

@@ -159,7 +159,7 @@ module CamlObjectProxy = struct
             sel
       in
       let methods =
-        Property.obj_prop ivar_name @
+        Property.define ivar_name Objc_t.id @
         [ Method.define
           ~cmd: (selector "initWithTargetObject:")
           ~args: Objc_t.[id]

runtime/define.ml

@@ -10,10 +10,6 @@ type 'a method_spec =
 
 type method_spec' = MethodSpec : 'a method_spec -> method_spec'
 
-let method_spec ~cmd ~typ ~imp ~enc =
-  MethodSpec {cmd; typ; imp; enc}
-;;
-
 type 'a ivar_spec =
   { name : string
   ; typ : 'a typ
@@ -22,17 +18,6 @@ type 'a ivar_spec =
 
 type ivar_spec' = IvarSpec : 'a ivar_spec -> ivar_spec'
 
-let ivar_spec ~name ~typ ~enc = IvarSpec {name; typ; enc}
-
-let _method_ imp ~cmd ~args ~return =
-  let typ = Objc_t.method_typ ~args return
-  and enc = Objc_t.Encode._method_ ~args return
-  in
-  method_spec ~cmd ~typ ~imp ~enc
-;;
+let method_spec ~cmd ~typ ~imp ~enc = MethodSpec {cmd; typ; imp; enc}
 
-let ivar name typ =
-  let typ = Objc_t.(value_typ typ)
-  and enc = Objc_t.(Encode.value typ)
-  in ivar_spec ~name ~typ ~enc
-;;
+let ivar_spec ~name ~typ ~enc = IvarSpec {name; typ; enc}

runtime/runtime.ml

@@ -347,13 +347,21 @@ module Method = struct
   let invoke ~typ ~self m =
     foreign "method_invoke" (id @-> _Method @-> typ) self m
 
-  let define = Define._method_
+  let define imp ~cmd ~args ~return =
+    let typ = Objc_t.method_typ ~args return
+    and enc = Objc_t.Encode._method_ ~args return
+    in
+    Define.method_spec ~cmd ~typ ~imp ~enc
 end
 
 module Ivar = struct
   include C.Functions.Ivar
 
-  let define = Define.ivar
+  let define name typ =
+    let typ = Objc_t.(value_typ typ)
+    and enc = Objc_t.(Encode.value typ)
+    in
+    Define.ivar_spec ~name ~typ ~enc
 end
 
 let get_property ~typ prop_name self =
@@ -411,52 +419,62 @@ module Property = struct
   let obj_setter
     ?(assign = false)
     ?(copy = false)
-    ~ivar_name
     ~typ
     ~enc
-    ()
+    ivar_name
   =
-    let cmd = selector (setter_name_of_ivar ivar_name)
-    and imp self _cmd value =
-      if not assign && not copy then
-        value |> retain |> ignore;
-
-      (* release old object *)
-      let ivar =
-        Class.get_instance_variable
-          ~self: (Object.get_class self)
-          ~name: ivar_name
-      in
-      Object.get_ivar ~self ~ivar |> release;
-
-      assert (not (is_null ivar));
-      Object.set_ivar ~self ~ivar (if copy then _copy_ value else value)
+  let cmd = selector (setter_name_of_ivar ivar_name)
+  and imp self _cmd value =
+    if not assign && not copy then
+      value |> retain |> ignore;
+
+    (* release old object *)
+    let ivar =
+      Class.get_instance_variable
+        ~self: (Object.get_class self)
+        ~name: ivar_name
     in
-    method_spec ~cmd ~typ: (typ @-> returning void) ~imp ~enc
-  ;;
+    Object.get_ivar ~self ~ivar |> release;
 
-  (** Getter and setter for a non-object property. *)
-  let value_prop ivar_name typ =
-    let typ = Objc_t.(value_typ typ)
-    and enc = Objc_t.(Encode.value typ)
-    in
-    [ getter ~ivar_name ~typ ~enc
-    ; setter ~ivar_name ~typ ~enc
-    ]
-  ;;
-
-  (** Getter and setter for an object property. *)
-  let obj_prop
+    assert (not (is_null ivar));
+    Object.set_ivar ~self ~ivar (if copy then _copy_ value else value)
+  in
+  method_spec ~cmd ~typ: (typ @-> returning void) ~imp ~enc
+
+  (** Definition of a property getter and (optionally) setter. *)
+  let define :
+    type a.
+    ?assign:bool ->
+    ?copy:bool ->
+    ?readonly:bool ->
+    string ->
+    a Objc_t.t ->
+    Define.method_spec' list
+  = fun
     ?(assign = false)
     ?(copy = false)
+    ?(readonly = false)
     ivar_name
-  =
-  let typ = Objc_t.(value_typ id)
-  and enc = Objc_t.(Encode.value id)
-  in
-  [ obj_getter ~ivar_name ~typ ~enc
-  ; obj_setter ~assign ~copy ~ivar_name ~typ ~enc ()
-  ]
+    t
+  ->
+    let typ = Objc_t.value_typ t
+    and enc = Objc_t.Encode.value t
+    in
+    match t with
+    | Objc_t.Id ->
+      if readonly then
+        [ obj_getter ~ivar_name ~typ ~enc ]
+      else
+        [ obj_getter ~ivar_name ~typ ~enc
+        ; obj_setter ~assign ~copy ~typ ~enc ivar_name
+        ]
+    | _ ->
+      if readonly then
+        [ getter ~ivar_name ~typ ~enc ]
+      else
+        [ getter ~ivar_name ~typ ~enc
+        ; setter ~ivar_name ~typ ~enc
+        ]
 end
 
 (* Exception handling *)

test/test-camlkit-base/test_objc.ml

@@ -141,7 +141,7 @@ let test_add_ivar ~name x () =
 
 let test_value_accessors ~name x () =
   let ivars = [Ivar.define "myVar" Objc_t.int]
-  and methods = Property.value_prop "myVar" Objc_t.int
+  and methods = Property.define "myVar" Objc_t.int
   in
   let self = _new_ (Class.define name ~ivars ~methods) in
   Objc.msg_send
@@ -159,7 +159,7 @@ let test_value_accessors ~name x () =
 
 let test_object_accessors ~name x () =
   let ivars = [Ivar.define "myVar" Objc_t.id]
-  and methods = Property.obj_prop "myVar"
+  and methods = Property.define "myVar" Objc_t.id
   in
   let self = _new_ (Class.define name ~ivars ~methods) in
   Objc.msg_send ~self
@@ -250,7 +250,7 @@ let test_msg_send_super () =
   let class_a =
     Class.define "ClassA"
       ~methods:
-        [ Define._method_
+        [ Method.define
           ~cmd: (selector "someMethod")
           ~args: Objc_t.[]
           ~return: Objc_t.void
@@ -261,7 +261,7 @@ let test_msg_send_super () =
     Class.define "ClassB"
       ~superclass: class_a
       ~methods:
-        [ Define._method_
+        [ Method.define
           ~cmd: (selector "someMethod")
           ~args: Objc_t.[]
           ~return: Objc_t.void