~subsetpark/fugue

0587dd027a927174d3025abe17a4fcde9b2f5b3f — Zach Smith 5 months ago 46f6be4
Use @ macro instead of qualified getters
2 files changed, 31 insertions(+), 49 deletions(-)

M fugue.janet
M test/fugue.janet
M fugue.janet => fugue.janet +27 -45
@@ 175,48 175,22 @@

(eval (new-form 'Root))

(defn- all-accessors
  "Recurse upwards to generate qualified forms for inherited accessors"
  [proto acc]
  (match proto
    {:_meta {:accessors accessors}} (all-accessors
                                      (table/getproto proto)
                                      (merge acc accessors))
    nil acc))

(defn- getters
  [name parent [_ _ _ _ accessors]]
  (let [forms @[]
        all-accessors (all-accessors parent accessors)]
    (loop [[field-name accessor-name] :pairs all-accessors
           :let [key-field (keyword field-name)]]
      (when-let [docstring (string "Get " field-name " from a " name)
                 # Generate qualified (prefixed with Proto name)
                 # accessor as well as unqualified
                 qualified-name (symbol name "-" accessor-name)]
        (with-syms [self]
          (array/push forms ~(defn ,accessor-name
                               ,docstring
                               [,self]
                               (let [current-fields (,fields ,self)]
                                 (unless (,index-of ,key-field current-fields)
                                   (,errorf "type error: expected proto with field %q, got %s with fields: %q"
                                      ,key-field
                                      (in ,self :_name)
                                      current-fields)))
                               (,in ,self ,key-field)))
          (array/push forms ~(defn ,qualified-name
                               ,docstring
                               [,self]
                               (unless (,(pred-name name) ,self)
                                 (let [found-name (match (,get-type-or-proto ,self)
                                                    @{:_name name} name
                                                    type type)]
                                   (,errorf "type error: expected %q, got: %q"
                                      ',name
                                      found-name)))
                               (,in ,self ,key-field))))))
    forms))
  (seq [[field-name accessor-name] :pairs accessors
        :let [key-field (keyword field-name)
              docstring (string "Get " field-name " from a " name)]]
    (with-syms [self]
      ~(defn ,accessor-name
         ,docstring
         [,self]
         (let [current-fields (,fields ,self)]
           (unless (,index-of ,key-field current-fields)
             (,errorf "type error: expected proto with field %q, got %s with fields: %q"
                ,key-field
                (in ,self :_name)
                current-fields)))
         (,in ,self ,key-field)))))

(defmacro defproto
  ````


@@ 252,11 226,7 @@
  to prevent a getter from being defined.

  `defproto` will define a getter function for each of the defined
  fields, unless `:getter` is false. It will also define a "qualified"
  getter function, where the getter-name is prepended by the name of
  the prototype. This can be used to provide a greater degree of
  "type-safety", as the qualified getter won 't be defined if that
  prototype doesn 't have that field.
  fields, unless `:getter` is false.

  `defproto` will also create a `:new` method in the created
  prototype. This will take as positional arguments all of the fields


@@ 723,3 693,15 @@
  ```
  [proto obj as & body]
  (with-slots-as proto obj as body))

(defmacro @
  ```
  Compile-time Prototype field checking. Translates into ordinary
  field keyword name, if `field` is present on `proto`.
  ```
  [proto field]
  (let [fields (fields (eval proto))]
    (unless (index-of field fields)
      (errorf "Field `%s` not found; Got fields: %q" (string field) fields)))

  field)

M test/fugue.janet => test/fugue.janet +4 -4
@@ 151,7 151,7 @@

    (is (thrown? (size Dog)))
    (is (= "Fido" (name a-pekingese)))
    (is (= "Fido" (Pekingese-name a-pekingese)))
    (is (= "Fido" (a-pekingese (fugue/@ Pekingese :name))))

    (is (= "Extremely Small" (size a-pekingese)))



@@ 164,7 164,7 @@
    (is (Dog*? Pekingese))

    (is (= "blue" (collar-color a-pekingese)))
    (is (= "blue" (Pekingese-collar-color a-pekingese)))))
    (is (= "blue" (a-pekingese (fugue/@ Pekingese :collar-color))))))

(fugue/defproto Form () unique-field {:getter get-unique-field})



@@ 174,8 174,8 @@
    (is (== @{'unique-field 'get-unique-field} (get-in Form [:_meta :accessors])))
    (is (nil? (dyn 'unique-field)))
    (is (= :echo (get-unique-field a-form)))
    (is (= :echo (Form-get-unique-field a-form)))
    (is (thrown? (Form-get-unique-field a-dog)))))
    (is (= :echo (a-form (fugue/@ Form :unique-field))))
    (is (thrown? (apply fugue/@ '[Dog :unique-field])))))

(fugue/defproto Form2 () second-unique-field {:getter false})