;;; ob-java.el --- org-babel functions for java evaluation -*- lexical-binding: t -*-


;; Copyright (C) 2011-2020 Free Software Foundation, Inc.

;; Author: Eric Schulte, Ian Martins
;; Keywords: literate programming, reproducible research
;; Homepage: https://orgmode.org

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; Org-Babel support for evaluating java source code.

;;; Code:
(require 'ob)

(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("java" . "java"))

(defvar org-babel-default-header-args:java '()
  "Default header args for java source blocks.")

(defconst org-babel-header-args:java '((imports . :any))
  "Java-specific header arguments.")

(defvar org-babel-java-compiler-command "javac"
  "Name of the command to execute the java compiler.")

(defvar org-babel-java-runtime-command "java"
  "Name of the command to run the java runtime.")

(defcustom org-babel-java-hline-to "null"
  "Replace hlines in incoming tables with this when translating to java."
  :group 'org-babel
  :version "25.2"
  :package-version '(Org . "9.3")
  :type 'string)

(defcustom org-babel-java-null-to 'hline
  "Replace `null' in java tables with this before returning."
  :group 'org-babel
  :version "25.2"
  :package-version '(Org . "9.3")
  :type 'symbol)

(defun org-babel-execute:java (body params)
  "Execute a java source block with BODY code and PARAMS params."
  (let* ((fullclassname (or (cdr (assq :classname params)) ; class and package
                            (org-babel-java-find-classname body)))
         (classname (if (seq-contains fullclassname ?.)    ; just class name
                        (file-name-extension fullclassname)
                      fullclassname))
         (packagename (if (seq-contains fullclassname ?.)  ; just package name
                          (file-name-base fullclassname)))
         (tmpdir (file-name-as-directory (org-babel-temp-file "java-" nil t)))
         (packagedir (if packagename                       ; package name as a path
                         (concat tmpdir
                                 (replace-regexp-in-string "\\\." "/" packagename))
                       tmpdir))
         (src-file (concat tmpdir
                           (replace-regexp-in-string "\\\." "/" fullclassname)
                           ".java"))
         (cmdline (or (cdr (assq :cmdline params)) ""))
         (cmd (concat org-babel-java-compiler-command " "
                      (org-babel-process-file-name src-file 'noquote)
                      " && " org-babel-java-runtime-command
                      " -cp " (org-babel-process-file-name tmpdir 'noquote)
                      " " fullclassname " " cmdline))
         (result-type (cdr (assq :result-type params)))
         (result-params (cdr (assq :result-params params)))
         (tmp-file (and (eq result-type 'value)
                        (org-babel-temp-file "java-")))
         (full-body (org-babel-expand-body:java
                     body params classname packagename result-type tmp-file)))

    ;; created package-name directories if missing
    (unless (or (not packagedir) (file-exists-p packagedir))
      (make-directory packagedir 'parents))

    (with-temp-file src-file (insert full-body))
    (org-babel-reassemble-table
     (org-babel-java-evaluate cmd result-type result-params tmp-file)
     (org-babel-pick-name
      (cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
     (org-babel-pick-name
      (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))

;; helper functions

(defun org-babel-java-find-classname (body)
  "Try to find fully qualified classname in BODY."
  (let ((package (if (string-match "package \\\([^ ]*\\\);" body)
                     (match-string 1 body)))
        (class (if (string-match "public class \\\([^ \n]*\\\)" body)
                   (match-string 1 body))))
    (or (and package class (concat package "." class))
        (and class class)
        (and package (concat package ".Main"))
        "Main")))

(defun org-babel-expand-body:java (body params classname packagename
                                        result-type tmp-file)
  "Expand BODY with PARAMS.
BODY could be a few statements, or could include a full class
definition specifying package, imports, and class.  Because we
allow this flexibility in what the source block can contain, it
is simplest to expand the code block from the inside out.

CLASSNAME name of the class, which may have been specified
in multiple ways.

PACKAGENAME name of the java package containing this class.

RESULT-TYPE output or value.

TMP-FILE name of tempfile to write to if value `result-type'."
  (let* ((var-lines (org-babel-variable-assignments:java params))
         (imports-val (assq :imports params))
         (imports (if imports-val
                      (split-string (org-babel-read (cdr imports-val) nil) " ")
                    nil))
         (package-re "^[[:space:]]*package .*;$")
         (imports-re "^[[:space:]]*import .*;$")
         (class-re "^public class [[:alnum:]_]+[[:space:]]*\n?[[:space:]]*{")
         (main-re "public static void main(String\\(?:\\[]\\)? args\\(?:\\[]\\)?).*\n?[[:space:]]*{")
         (move-past (lambda (re) (while (re-search-forward re nil t)
                                   (goto-char (1+ (match-end 0)))))))
    (with-temp-buffer
      (insert body)

      ;; wrap main
      (goto-char (point-min))
      (when (not (re-search-forward main-re nil t))
        (funcall move-past package-re) ; if package is defined, move past it
        (funcall move-past imports-re) ; if imports are defined, move past them
        (insert "public static void main(String[] args) {\n")
        (goto-char (point-max))
        (insert "\n}"))

      ;; wrap class
      (goto-char (point-min))
      (when (not (re-search-forward class-re nil t))
        (funcall move-past package-re) ; if package is defined, move past it
        (funcall move-past imports-re) ; if imports are defined, move past them
        (insert (concat  "public class " (file-name-base classname) " {\n"))
        (goto-char (point-max))
        (insert "\n}"))

      ;; insert variables
      (when var-lines
        (goto-char (point-min))
        (funcall move-past class-re)   ; move inside class
        (insert (mapconcat 'identity var-lines "\n"))
        (insert "\n"))

      ;; special handling to return value
      (when (eq result-type 'value)
        (goto-char (point-min))
        (funcall move-past class-re)   ; move inside class
        (insert "\n    public static String __toString(Object val) {\n")
        (insert "        if (val instanceof String) {\n")
        (insert "            return \"\\\"\" + val + \"\\\"\";\n")
        (insert "        } else if (val == null) {\n")
        (insert "            return \"null\";\n")
        (insert "        } else if (val.getClass().isArray()) {\n")
        (insert "            StringBuffer sb = new StringBuffer();\n")
        (insert "            Object[] vals = (Object[])val;\n")
        (insert "            sb.append(\"[\");\n")
        (insert "            for (int ii=0; ii<vals.length; ii++) {\n")
        (insert "                sb.append(__toString(vals[ii]));\n")
        (insert "                if (ii<vals.length-1)\n")
        (insert "                    sb.append(\",\");\n")
        (insert "            }\n")
        (insert "            sb.append(\"]\");\n")
        (insert "            return sb.toString();\n")
        (insert "        } else if (val instanceof List) {\n")
        (insert "            StringBuffer sb = new StringBuffer();\n")
        (insert "            List vals = (List)val;\n")
        (insert "            sb.append(\"[\");\n")
        (insert "            for (int ii=0; ii<vals.size(); ii++) {\n")
        (insert "                sb.append(__toString(vals.get(ii)));\n")
        (insert "                if (ii<vals.size()-1)\n")
        (insert "                    sb.append(\",\");\n")
        (insert "            }\n")
        (insert "            sb.append(\"]\");\n")
        (insert "            return sb.toString();\n")
        (insert "        } else {\n")
        (insert "            return String.valueOf(val);\n")
        (insert "        }\n")
        (insert "    }\n\n")
        (insert "    public static void main(String[] args) throws IOException {\n")
        (insert (format "        BufferedWriter output = new BufferedWriter(new FileWriter(\"%s\"));\n" (org-babel-process-file-name tmp-file 'noquote)))
        (insert "        output.write(__toString(_main(args)));\n")
        (insert "        output.close();\n")
        (insert "    }\n\n")
        (search-forward "public static void main(") ; rename existing main
        (replace-match "public static Object _main("))

      ;; add imports
      (if (eq result-type 'value)
          (setq imports (append '("java.io.BufferedWriter" "java.io.FileWriter" "java.io.IOException") imports)))
      (if (seq-some (lambda (var-line) (string-match-p "List" var-line)) var-lines)
          (setq imports (append '("java.util.Arrays") imports)))
      (setq imports (append '("java.util.List") imports)) ; always needed for toString
      (when imports
        (goto-char (point-min))
        (funcall move-past package-re) ; if package is defined, move past it
        (insert (mapconcat (lambda (package) (concat "import " package ";")) (delete-dups imports) "\n") "\n"))

      ;; add package at the top
      (goto-char (point-min))
      (when (and packagename (not (re-search-forward package-re nil t)))
        (insert (concat "package " packagename ";\n\n")))

      ;; return expanded body
      (buffer-string))))

(defun org-babel-variable-assignments:java (params)
  "Return a list of java statements assigning the block's variables.
variables are contained in PARAMS."
  (mapcar
   (lambda (pair)
     (let* ((type-data (org-babel-java-val-to-type (cdr pair)))
            (basetype (car type-data))
            (var-to-java (lambda (var) (funcall #'org-babel-java-var-to-java var basetype))))
       (format "    static %s %s = %s;"
               (cdr type-data)                     ; type
               (car pair)                          ; name
               (funcall var-to-java (cdr pair))))) ; value
   (org-babel--get-vars params)))

(defun org-babel-java-var-to-java (var basetype)
  "Convert an elisp value to a java variable.
Convert an elisp value, VAR, of type BASETYPE into a string of
java source code specifying a variable of the same value."
  (cond ((and (sequencep var) (not (stringp var)))
         (let ((var-to-java (lambda (var) (funcall #'org-babel-java-var-to-java var basetype))))
           (concat "Arrays.asList(" (mapconcat var-to-java var ", ") ")")))
        ((eq var 'hline) org-babel-java-hline-to)
        ((eq basetype 'integerp) (format "%d" var))
        ((eq basetype 'floatp) (format "%f" var))
        ((eq basetype 'stringp) (if (and (stringp var) (string-match-p ".\n+." var))
                                    (error "Java does not support multiline string literals")
                                  (format "\"%s\"" var)))))

(defun org-babel-java-val-to-type (val)
  "Determine the type of VAL.
Return (BASETYPE . LISTTYPE), where BASETYPE is a symbol
representing the type of the individual items in VAL, and
LISTTYPE is a string name of the type parameter for a container
for BASETYPE items."
  (let* ((basetype (org-babel-java-val-to-base-type val))
         (basetype-str (pcase basetype
                         (`integerp "Integer")
                         (`floatp "Double")
                         (`stringp "String")
                         (_ (error "Unknown type %S" basetype)))))
    (cond
     ((and (listp val) (listp (car val))) ; a table
      (cons basetype (format "List<List<%s>>" basetype-str)))
     ((or (listp val) (vectorp val)) ; a list declared in the #+begin_src line
      (cons basetype (format "List<%s>" basetype-str)))
     (t ; return base type
      (cons basetype basetype-str)))))

(defun org-babel-java-val-to-base-type (val)
  "Determine the base type of VAL.
VAL may be
`integerp' if all base values are integers
`floatp' if all base values are either floating points or integers
`stringp' otherwise."
  (cond
   ((integerp val) 'integerp)
   ((floatp val) 'floatp)
   ((or (listp val) (vectorp val))
    (let ((type nil))
      (mapc (lambda (v)
              (pcase (org-babel-java-val-to-base-type v)
                (`stringp (setq type 'stringp))
                (`floatp
                 (when (or (not type) (eq type 'integerp))
                   (setq type 'floatp)))
                (`integerp
                 (unless type (setq type 'integerp)))))
            val)
      type))
   (t 'stringp)))

(defun org-babel-java-table-or-string (results)
  "Convert RESULTS into an appropriate elisp value.
If the results look like a list or vector, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
  (let ((res (org-babel-script-escape results)))
    (if (listp res)
        (mapcar (lambda (el) (if (eq 'null el)
                                 org-babel-java-null-to
                               el))
                res)
      res)))

(defun org-babel-java-evaluate (cmd result-type result-params tmp-file)
  "Evaluate using an external java process.
CMD the command to execute.

If RESULT-TYPE equals 'output then return standard output as a
string.  If RESULT-TYPE equals 'value then return the value
returned by the source block, as elisp.

RESULT-PARAMS input params used to format the reponse.

TMP-FILE filename of the tempfile to store the returned value in
for 'value RESULT-TYPE.  Not used for 'output RESULT-TYPE."
  (let ((raw (cond ((eq result-type 'output)
                    (org-babel-eval cmd ""))
                   (t
                    (org-babel-eval cmd "")
                    (org-babel-eval-read-file tmp-file)))))
    (org-babel-result-cond result-params raw
      (org-babel-java-table-or-string raw))))

(provide 'ob-java)

;;; ob-java.el ends here