;;; conlanging-graphviz.el --- Graphviz utilities for conlanging -*- lexical-binding: t -*-

;; Author: Lucien Cartier-Tilet <lucien@phundrak.com>
;; Maintainer: Lucien Cartier-Tilet <lucien@phundrak.com>
;; Version: 0.1.0
;; Package-Requires: ((emacs "26.1"))
;; Homepage: https://labs.phundrak.com/phundrak/conlanging.el
;; Keywords: convenience


;; This file is not part of GNU Emacs

;; This program 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.

;; This program 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 this program.  If not, see <https://www.gnu.org/licenses/>.


;;; Code:
(require 'ox)

(defun conlanging-graphviz--node-link (node parent)
  "Create a graphviz node between NODE and PARENT.
Both NODE and PARENT must be the name and not the label of the
node."
  (format "\"%s\"--\"%s\";" parent node))

(defun conlanging-graphviz--node (name label)
  "Create a node named NAME with the label LABEL."
  (format "\"%s\"[label=\"%s\"];" name label))

(defun conlanging-graphviz--str-add-id (str)
  "Append a unique id to STR."
  (concat str "-" (org-id-time-to-b36)))

;;;###autoload
(defun conlanging-graphviz-list-to-graphviz (list &optional previous-node-name)
  "Convert LIST into a graphviz tree.
LIST must be in the form of

    (\"label\"
       child1
       child2
       ...)

with each child being either another list in the same for or a
string which is then a leaf.

PREVIOUS-NODE-NAME is the parent node of the current tree being
formed. If it is nil, then it means the current tree is the root
tree itself."
  (cond
   ((listp list) ;; it's a node!
    (let* ((tree-root-p (null previous-node-name))
           (node-label  (car list))
           (node-name   (conlanging-graphviz--str-add-id node-label))
           (graph-str   (if tree-root-p
                            "graph{graph[dpi=300,bgcolor=\"transparent\"];node[shape=plaintext];"
                          "")))
      (setq graph-str
            (concat graph-str
                    (conlanging-graphviz--node node-name node-label)
                    (if (not tree-root-p)
                        (conlanging-graphviz--node-link node-name previous-node-name)
                      "")))
      (dolist (child (cdr list) graph-str)
        (setf graph-str (concat graph-str
                                (conlanging-graphviz-list-to-graphviz child node-name))))
      (concat graph-str (if tree-root-p "}" ""))))
   ((stringp list) ;; it's a leaf!
    (let ((name (conlanging-graphviz--str-add-id list)))
      (concat (conlanging-graphviz--node name list)
              (conlanging-graphviz--node-link name previous-node-name))))
   (t (error "Cannot handle something that isn't a string or a list!"))))

;;;###autoload
(cl-defun conlanging-graphviz-feature-tree (node &key ((:previous previous-node-name) nil) (label ""))
  "Create a feature tree from NODE.

LABEL is the label of the root node.

PREVIOUS is for internal use. It refers to the parent node of
NODE if NODE is a subtree of the root tree."
  (cond
   ((stringp node) ;; it's a leaf!
    (let ((name (conlanging-graphviz--str-add-id node)))
      (concat (conlanging-graphviz--node name node)
              (conlanging-graphviz--node-link name previous-node-name))))
   ((listp node) ;; it's a node!
    (let* ((tree-root-p         (null previous-node-name))
           (root-name           (or previous-node-name
                                    (conlanging-graphviz--str-add-id label)))
           (positive-node-label (concat "+" (car node)))
           (positive-node-name  (conlanging-graphviz--str-add-id positive-node-label))
           (negative-node-label (concat "-" (car node)))
           (negative-node-name  (conlanging-graphviz--str-add-id negative-node-label))
           (graph-header        (if tree-root-p
                                    (concat "graph{graph[dpi=300,bgcolor=\"transparent\"];node[shape=plaintext];"
                                            (conlanging-graphviz--node root-name label))
                                  "")))
      ;; create positive label
      (concat graph-header
              (conlanging-graphviz--node positive-node-name positive-node-label)
              (conlanging-graphviz--node-link positive-node-name root-name)
              (conlanging-graphviz-feature-tree (nth 1 node) :previous positive-node-name)
              (conlanging-graphviz--node negative-node-name negative-node-label)
              (conlanging-graphviz--node-link negative-node-name root-name)
              (conlanging-graphviz-feature-tree (nth 2 node) :previous negative-node-name)
              (if tree-root-p "}" ""))))))

(provide 'conlanging-graphviz)

;;; conlanging-graphviz.el ends here