Attempts at creating clean subclasses (with closure compiler annotations) in clojurescript with macros

subclass.cljs

(ns subclass
  (:require [clojure.string :as string]))

;;TODO: definterface


; :closure/const
; :const
; :closure/constructor
; :closure/depreciated
; :closure/dict
; :closure/struct
; :closure/inheritDoc
; :closure/interface
; :closure/override
; :closure/expose
; :export => goog/exportProperty(proto, (name fname), fn)
; :closure/private
; :private
; :closure/protected
; :protected
; :closure/typedef

; :closure/define type
; :closure/enum type
; :closure/extends type
; :closure/implements type
; :closure/params [type | [type flag], ...]
; :closure/return type
; :closure/this type
; :closure/type type

; flag:
; :optional
; :variable

; type-simple:
; "type" => {type}
; js/undefined => {undefined}
; js/Object => {Object}
; js/Array => {Array}
; 'array => {Array}
; 'number|boolean|string => {number boolean string}
; '*   => {*}
; '?   => {?}
; sym => {ns.name}

; type-compound:
; '(*) => {function()}
; '(type1 type2 *) => {function(type1, type2)}
; '(rtype) => {function(): rtype}
; '(type1 rtype) => {function(type1): rtype}
; '(:this type, :new type *) => {function(this:type new:type)}
; '(:variable type *) => {function(...[type])}
; '(:optional type *) => {function(type=)}
; #{"type" ns/name} => {(type|ns.name)}
; #{"type" nil}    => {?type}
; #{"type" :not-null} => {!type}



; :closure/const
; :const
; :closure/constructor
; :closure/depreciated
; :closure/dict
; :closure/struct
; :closure/inheritDoc
; :closure/interface
; :closure/override
; :closure/expose
; :export => goog/exportProperty(proto, (name fname), fn)
; :closure/private
; :private
; :closure/protected
; :protected
; :closure/typedef

(defn jsdoc-annotations [metas]
  (let [simple-annotations #{:closure/const
                             :const
                             :closure/constructor
                             :closure/depreciated
                             :closure/dict
                             :closure/struct
                             :closure/inheritDoc
                             :closure/interface
                             :closure/override
                             :closure/expose
                             :closure/private
                             :private
                             :closure/protected
                             :protected
                             :closure/typedef}]
    (reduce (fn [ms [k v]] (conj ms (str "@" (name k))))
            [] (select-keys metas simple-annotations))))

(defn jsdoc [docstr annotations]
  (string/join "\n"
               (concat
                 ["/**"]
                 (if (not-empty docstr)
                   (->> docstr
                        string/split-lines
                        (map #(str " * " (string/trim %))))
                   [])
                 [" *"]
                 (map #(str " * " %) annotations)
                 [" */"])))

(defn classmember* [classsym msym & forms]
  (if-not (string? (first forms))
    (apply classmember* classsym msym "" (rest forms))
    (let [static? (:static (meta msym))
          fsym      (symbol (str "-" msym))
          [docstr & forms] forms]
      `(do
         (~'js* ~(str (jsdoc docstr (jsdoc-annotations (meta msym)))
                      "~{REST}")
                (set! (.. ~classsym ~'-prototype ~fsym)
                      ~(if static?
                         `(do ~@forms)
                         `(fn [& ~'args] (apply (fn ~@forms) (~'js* "this") ~'args)))))))))


;; TODO: multiple arity constructor
;; TODO: optional classdoc
;; TODO: with-jsdoc macro?
;; TODO: type annotation parsing
;; TODO: set @params automatically?
(defmacro defclass [classname parent classdoc [ctorparams & ctorbody] & members]  
  `(do
     (def ~classname
       ~(string/join "\n"
                     (concat [classdoc] (jsdoc-annotations (meta classname))
                             ["@constructor" (str "@extends " (namespace parent)
                                                  "." (name parent))]))
       ~(if (not-empty ctorparams)
          `(fn ~(subvec ctorparams 1)
             (let [~(first ctorparams) (~'js* "this")
                   parent-ctor (goog/bind parent (~'js* "this"))]
               ~@ctorbody)
             nil)
          `(fn [] ~@ctorbody nil)))
     #_(goog/provide (str *ns* "." (name classname)))
     (goog/inherits ~classname ~parent)
     ~@(map (partial apply classmember* classname) members)
     ~classname))


; Example:
;
; (macroexpand-1
; '(defsubclass theclass parent "Class documentation"
;   ([this p1 p2] (set! (.-p1 this) p1))
;   (^:static f1 nil)
;   (m1 "doc" [this rest] nil)
;   (m2 ([this] nil) ([this a] nil))))
;
; => (do (def theclass "Class documentation\n@constructor\n@extends .parent" (clojure.core/fn [p1 p2] (cljs.core/this-as this (set! (.-p1 this) p1)) nil)) (goog/inherits theclass parent) (do (js* "/**\n * doc\n *\n */~{REST}" (set! (.. theclass -prototype -m1) (clojure.core/fn [& args] (clojure.core/apply (clojure.core/fn [this rest] nil) (js* "this") args))))) (do (js* "/**\n *\n */~{REST}" (set! (.. theclass -prototype -m2) (clojure.core/fn [& args] (clojure.core/apply (clojure.core/fn ([this a] nil)) (js* "this") args))))))