;;; ob-haxe.el --- org-babel functions for haxe evaluation

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

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

;; This file is not 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 <http://www.gnu.org/licenses/>.

;;; Commentary:

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

;;; Code:
(require 'ob)

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

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

(defconst org-babel-header-args:haxe '((target . '(interp neko hashlink))
                                       (imports . :any))
  "Haxe-specific header arguments.
org-babel supports three of the platforms the haxe compiler can target.

  `interp' runs the haxe compiler with the `--interp' option.
  `neko' and `hashlink' compile to bytecode and run the
  respective VMs.")

(defvar org-babel-haxe-command "haxe"
  "Name of the haxe command.")

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

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

(defun org-babel-execute:haxe (body params)
  "Execute a haxe source block with BODY code and PARAMS params."
  (let* ((fullclassname (or (cdr (assq :classname params)) ; class and package
                            (org-babel-haxe-find-classname body)
                            "Main"))
         (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)
                        ""))
         (packagedir (if (not (seq-empty-p packagename))   ; package name as a path
                         (replace-regexp-in-string "\\\." "/" packagename)))
         (src-file (concat (replace-regexp-in-string "\\\." "/" fullclassname) ".hx"))
         (cmdline (or (cdr (assq :cmdline params)) ""))
         (target-name (cdr (assq :target params)))
         (target (cond ((string= target-name "neko") "-neko main.n -cmd \"neko main.n\"")
                       ((string= target-name "hashlink") "-hl main.hl -cmd \"hl main.hl\"")
                       (t "--interp")))
         (cmd (concat org-babel-haxe-command
                      " " cmdline " -main " fullclassname " " target))
         (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 "haxe-")))
         (full-body (org-babel-expand-body:haxe
                     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-haxe-evaluate cmd target-name 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-haxe-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 "class \\\([^ \n]*\\\)" body)
                   (match-string 1 body))))
    (or (and package class (concat package "." class))
        class)))

(defun org-babel-expand-body:haxe (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:haxe params))
         (imports-val (assq :imports params))
         (imports (if imports-val
                      (split-string (org-babel-read (cdr imports-val) nil) " ")
                    nil)))
    (with-temp-buffer
      (insert body)

      ;; wrap main
      (goto-char (point-min))
      (when (not (re-search-forward "static .*function main\(\)" nil t))
        (while (re-search-forward "^[[:space:]]*import .*;$" nil t) ; if imports are defined, move past them
          (goto-char (1+ (match-end 0))))
        (insert "public static function main() {\n")
        (goto-char (point-max))
        (insert "\n}"))

      ;; insert variables
      (when var-lines
        (goto-char (point-min))
        (if (re-search-forward "^[[:space:]]*class .*\n?{[[:space:]]*$" nil t)
            (goto-char (1+ (match-end 0))))
        (insert (mapconcat 'identity var-lines "\n"))
        (insert "\n"))

      ;; special handling to return value
      (when (eq result-type 'value)
        (goto-char (point-min))
        (re-search-forward "^[[:space:]]*class .*\n?{" nil t)
        (insert "\n")
        (insert "    public static function main() {\n")
        (insert (format "        var output = File.write(\"%s\");\n" (org-babel-process-file-name tmp-file 'noquote)))
        (insert "        output.writeString(haxe.Json.stringify(_main()));\n")
        (insert "        output.close();\n")
        (insert "    }\n")
        (search-forward "function main()") ; rename existing main
        (replace-match "function _main()"))

      ;; wrap class
      (goto-char (point-min))
      (when (not (re-search-forward "^[[:space:]]*class [^ ]*" nil t))
        (while (re-search-forward "^[[:space:]]*import .*;$" nil t) ; if imports are defined, move past them
          (goto-char (1+ (match-end 0))))
        (insert (concat  "class " (file-name-base classname) " {\n"))
        (goto-char (point-max))
        (insert "\n}"))

      ;; add imports
      (if (eq result-type 'value)
          (setq imports (append '("sys.io.File") imports)))
      (when imports
        (if (re-search-forward "^[[:space:]]*package .*;$" nil t) ; if package is defined, move past it
            (goto-char (1+ (match-end 0))))
        (goto-char (point-min))
        (insert (mapconcat (lambda (ii) (concat "import " ii ";\n")) imports "\n")))

      ;; add package at the top
      (goto-char (point-min))
      (when (not (re-search-forward "^[[:space:]]*package .*;$" nil t))
        (insert (concat "package " packagename ";\n\n")))

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

(defun org-babel-variable-assignments:haxe (params)
  "Return a list of haxe statements assigning the block's variables.
variables are contained in PARAMS."
  (mapcar
   (lambda (pair)
     (format "    static var %s %s = %s;"
             (car pair)
             (if (and (sequencep (cdr pair))
                      (not (stringp (cdr pair)))) ":Array<Dynamic> " "")
             (org-babel-haxe-var-to-haxe (cdr pair))))
   (org-babel--get-vars params)))

(defun org-babel-haxe-var-to-haxe (var)
  "Convert an elisp value to a haxe variable.
Convert an elisp value, VAR, into a string of haxe source code
specifying a variable of the same value."
  (cond ((and (sequencep var)
              (not (stringp var)))
         (concat "[" (mapconcat #'org-babel-haxe-var-to-haxe var ", ") "]"))
        ((equal var 'hline)
         org-babel-haxe-hline-to)
        (t
         (format "%S" (if (stringp var) (substring-no-properties var) var)))))

(defun org-babel-haxe-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)))
    ;; (mapcar (lambda (el) (message "el %s %s" el (eq 'null el))) res)
    (if (listp res)
        (mapcar (lambda (el) (if (eq 'null el)
                               org-babel-haxe-null-to
                             el))
              res)
      res)))

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

TARGET the platform the haxe compiler should target.

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)))))
    (if (and
         (or (string= target "neko")
             (string= target "hashlink"))
         (eq result-type 'output))
        (setq raw (substring raw 0 -1))) ; neko and hashlink runtimes add a trailing endline
    (org-babel-result-cond result-params
      raw
      (org-babel-haxe-table-or-string raw))))

(provide 'ob-haxe)

;;; ob-haxe.el ends here