pjb-java-generate.el

(defparameter *dirpath* "~/src/Android-SDK/ubudu-sdk/src/com/ubudu/sdk/dto/")

(defparameter *java-current-package* 'com.example)
(defparameter *java-operators* '(+ - * / < > <= >= == ! && ||))

(defparameter *java-predefined-classes* '((java.lang . Object)
                                          (java.lang . String)
                                          (java.lang . Boolean)
                                          (java.lang . Integer)
                                          (java.lang . Double)
                                          (java.util . Date)
                                          (java.util . Vector)))



(defun java-in-package (package)
  (setf *java-current-package* package)
  (insert (format "package %s;\n\n" *java-current-package*)))

(defun java-import (full-qualified-class-name)
  (insert (format "import %s;\n" full-qualified-class-name)))

(defun* java-class (class-name &key superclass interfaces throws import-thunk body-thunk)
  (when import-thunk (funcall import-thunk))
  (insert (format  "public class %s" class-name))
  (when superclass
    (insert (format " extends %s" superclass)))
  (when interfaces
    (insert (format " implements %s" (join interfaces ","))))
  (when throws
    (insert (format " throws %s" (join throws ","))))
  (insert "{\n")
  (when body-thunk (funcall body-thunk))
  (insert "\n}\n"))

(defun java-parameters (parameters)
  (insert (format "(%s)" (join (mapcar (lambda (parameter)
                                         (destructuring-bind (name type) parameter
                                           (format "%s %s" (prepare-type type) name)))
                                       parameters)
                               ","))))

(defun java-expression (expression)
  (if (atom expression)
    (format "%s" expression)
    (let ((op (first expression))
          (args (rest expression)))
      (cond
       ((member op *java-operators*)
        (if (endp (rest args))
          (format "(%s%s)" op (java-expression (first args)))
          (format "(%s)" (join (mapcar (function java-expression) args)
                               (format "%s" op)))))
       ((eq op '\.)
        (java-send (first args) (second args) (cddr args)))
       (t
        (java-send nil op args))))))

(defun java-arguments (arguments)
  (insert (format "(%s)" (join (mapcar (function java-expression) arguments) ","))))

(defun arguments-from-parameters (parameters)
  (mapcar (lambda (parameter)
            (destructuring-bind (name type) parameter
              name))
          parameters))

(defun java-send (recipient message arguments)
  (insert (if recipient
             (format "%s.%s" recipient message)
             (format "%s" message)))
  (java-arguments arguments))


(defun java-constructor (class-name parameters)
  (insert (format "public %s" class-name))
  (java-parameters parameters)
  (insert "{" "\n")
  (java-send nil 'super (arguments-from-parameters parameters)) (insert ";" "\n")
  (insert "}" "\n"))



(defun java-class-package (class)
  (car (rassoc class *java-predefined-classes*)))

(defun java-fully-qualified-class (class)
  (intern (format "%s.%s" (or (java-class-package class)
                              *java-current-package*)
                  class)))

;; (java-fully-qualified-class 'Integer) java\.lang\.Integer
;; (java-fully-qualified-class 'Geofence) com\.example\.Geofence

(defun prepare-type (type)
  (if (atom type)
    type
    (format "%s<%s>" (first type) (join (mapcar (function prin1-to-string) (rest type)) ","))))

(defun* generate-java-class (file-name package-name class-name &key superclass interfaces throws fields)
  (save-excursion
    (find-file file-name)
    (erase-buffer)
    (insert "// -*- mode:java; coding:utf-8 -*-" "\n")
    (insert "// Generated automatically by generate.el" "\n" "\n")
    (java-in-package package-name)
    (dolist (class (remove-duplicates (append (when superclass (list superclass))
                                              interfaces
                                              (mapcan (lambda (field)
                                                        (if (atom (second field))
                                                          (list (second field))
                                                          (copy-list (second field))))
                                                      fields))))
      (java-import (java-fully-qualified-class class)))

    (java-class class-name
                :superclass superclass
                :interfaces interfaces
                :throws throws
                :import-thunk (lambda ()
                                (java-import 'com.google.gson.annotations.SerializedName))
                :body-thunk   (lambda ()
                                (java-constructor class-name '())
                                (dolist (field fields)
                                  (destructuring-bind (name type) field
                                    (let ((ptype  (prepare-type type)))
                                      (insert (format "@SerializedName(\"%s\")" name) "\n")
                                      (insert (format "public %s %s;" ptype name) "\n")
                                      )))))
    (save-buffer 0)
    (kill-buffer)))



(defmacro define-entity (class &rest fields)
  (let ((class-name (if (atom class)
                      class
                      (first class)))
        (superclass (if (atom class)
                      'Object
                      (second (assoc :superclass (rest class))))))
    `(generate-java-class ,(format "%s%s.java" *dirpath* class-name)
                          *java-current-package* ',class-name
                          :superclass ',superclass
                          :fields ',fields)))