;;; ztree-diff-model.el --- diff model for directory trees -*- lexical-binding: t; -*-

;; Copyright (C) 2013-2015  Free Software Foundation, Inc.
;;
;; Author: Alexey Veretennikov <alexey dot veretennikov at gmail dot com>
;; 
;; Created: 2013-11-1l
;;
;; Keywords: files tools
;; URL: https://github.com/fourier/ztree
;; Compatibility: GNU Emacs 24.x
;;
;; 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 <http://www.gnu.org/licenses/>.
;;
;;; Commentary:

;; Diff model

;;; Code:
(require 'ztree-util)

(defvar ztree-diff-model-wait-message nil
  "Message showing while constructing the diff tree.")
(make-variable-buffer-local 'ztree-diff-model-wait-message)

(defvar ztree-diff-model-ignore-fun nil
  "Function which determines if the node should be excluded from comparison.")
(make-variable-buffer-local 'ztree-diff-model-ignore-fun)

(defun ztree-diff-model-update-wait-message ()
  "Update the wait mesage with one more '.' progress indication."
  (when ztree-diff-model-wait-message
    (setq ztree-diff-model-wait-message (concat ztree-diff-model-wait-message "."))
    (message ztree-diff-model-wait-message)))

;; Create a record ztree-diff-node with defined fields and getters/setters
;; here:
;; parent - parent node
;; left-path is the full path on the left side of the diff window,
;; right-path is the full path of the right side,
;; short-name - is the file or directory name
;; children - list of nodes - files or directories if the node is a directory
;; different = {nil, 'new, 'diff} - means comparison status
(ztree-defrecord ztree-diff-node (parent left-path right-path short-name right-short-name children different))

(defun ztree-diff-model-ignore-p (node)
  "Determine if the NODE should be excluded from comparison results."
  (when ztree-diff-model-ignore-fun
    (funcall ztree-diff-model-ignore-fun node)))

(defun ztree-diff-node-to-string (node)
  "Construct the string with contents of the NODE given."
  (let* ((string-or-nil #'(lambda (x) (if x
                                          (cond ((stringp x) x)
                                                ((eq x 'new) "new")
                                                ((eq x 'diff) "different")
                                                (t (ztree-diff-node-short-name x)))
                                        "(empty)")))
         (children (ztree-diff-node-children node))
         (ch-str ""))
    (dolist (x children)
      (setq ch-str (concat ch-str "\n   * " (ztree-diff-node-short-name x))))
    (concat "Node: " (ztree-diff-node-short-name node)
            "\n"
            ;; " * Parent: " (let ((parent (ztree-diff-node-parent node)))
            ;;                 (if parent (ztree-diff-node-short-name parent) "nil"))
            " * Parent: " (funcall string-or-nil (ztree-diff-node-parent node))
            "\n"
            " * Left path: " (funcall string-or-nil (ztree-diff-node-left-path node))
            "\n"
            " * Right path: " (funcall string-or-nil (ztree-diff-node-right-path node))
            "\n"
            " * Children: " ch-str
            "\n")))


(defun ztree-diff-node-short-name-wrapper (node &optional right-side)
  "Return the short name of the NODE given.
If the RIGHT-SIDE is true, take the right leaf"
  (if (not right-side)
      (ztree-diff-node-short-name node)
    (ztree-diff-node-right-short-name node)))


(defun ztree-diff-node-is-directory (node)
  "Determines if the NODE is a directory."
  (let ((left (ztree-diff-node-left-path node))
        (right (ztree-diff-node-right-path node)))
    (if left
        (file-directory-p left)
      (file-directory-p right))))

(defun ztree-diff-node-side (node)
  "Determine the side there the file is present for NODE.
Return BOTH if the file present on both sides;
LEFT if only on the left side and
RIGHT if only on the right side."
  (let ((left (ztree-diff-node-left-path node))
        (right (ztree-diff-node-right-path node)))
    (if (and left right) 'both
      (if left 'left 'right))))

(defun ztree-diff-node-equal (node1 node2)
  "Determines if NODE1 and NODE2 are equal."
  (and (string-equal (ztree-diff-node-short-name node1)
                     (ztree-diff-node-short-name node2))
       (string-equal (ztree-diff-node-left-path node1)
                     (ztree-diff-node-left-path node2))
       (string-equal (ztree-diff-node-right-path node1)
                     (ztree-diff-node-right-path node1))))

(defun ztree-diff-untrampify-filename (file)
  "Return FILE as the local file name."
  (require 'tramp)
  (if (not (tramp-tramp-file-p file))
      file
    (tramp-file-name-localname (tramp-dissect-file-name file))))

(defun ztree-diff-modef-quotify-string (x)
  "Surround string X with quotes."
  (concat "\"" x "\""))

(defun ztree-diff-model-files-equal (file1 file2)
  "Compare files FILE1 and FILE2 using external diff.
Returns t if equal."
  (let* ((file1-untrampified (ztree-diff-untrampify-filename (ztree-diff-modef-quotify-string file1)))
         (file2-untrampified (ztree-diff-untrampify-filename (ztree-diff-modef-quotify-string file2)))
         (diff-command (concat "diff -q" " " file1-untrampified " " file2-untrampified))
         (diff-output (shell-command-to-string diff-command)))
    (not (> (length diff-output) 2))))

(defun ztree-directory-files (dir)
  "Return the list of full paths of files in a directory DIR.
Filters out . and .."
  (ztree-filter #'(lambda (file) (let ((simple-name (ztree-file-short-name file)))
                                   (not (or (string-equal simple-name ".")
                                            (string-equal simple-name "..")))))
                (directory-files dir 'full)))

(defun ztree-diff-model-partial-rescan (node)
  "Rescan the NODE."
  ;; assuming what parent is always exists
  ;; otherwise the UI shall force the full rescan
  (let ((parent (ztree-diff-node-parent node))
        (isdir (ztree-diff-node-is-directory node))
        (left (ztree-diff-node-left-path node))
        (right (ztree-diff-node-right-path node)))
    ;; if node is a directory - traverse
    (when (and left right
               (file-exists-p left)
               (file-exists-p right))
      (if isdir
          (let ((traverse (ztree-diff-node-traverse
                           node
                           left
                           right)))
            (ztree-diff-node-set-different node (car traverse))
            (ztree-diff-node-set-children node (cdr traverse)))
        ;; node is a file
        (ztree-diff-node-set-different
         node
         (if (ztree-diff-model-files-equal left right)
             nil
           'diff))))))

(defun ztree-diff-model-subtree (parent path side)
  "Create a subtree with given PARENT for the given PATH.
Argument SIDE either 'left or 'right side."
  (let ((files (ztree-directory-files path))
        (result nil))
    (dolist (file files)
      (if (file-directory-p file)
          (let* ((node (ztree-diff-node-create
                        parent
                        (when (eq side 'left) file)
                        (when (eq side 'right) file)
                        (ztree-file-short-name file)
                        (ztree-file-short-name file)
                        nil
                        'new))
                 (children (ztree-diff-model-subtree node file side)))
            (ztree-diff-node-set-children node children)
            (push node result))
        (push (ztree-diff-node-create
               parent
               (when (eq side 'left) file)
               (when (eq side 'right) file)
               (ztree-file-short-name file)
               (ztree-file-short-name file)
               nil
               'new)
              result)))
    result))

(defun ztree-diff-node-update-diff-from-children (node)
  "Set the diff status for the NODE based on its children."
  (let ((children (ztree-diff-node-children node))
        (diff nil))
    (dolist (child children)
      (unless (ztree-diff-model-ignore-p child)
        (setq diff
              (ztree-diff-model-update-diff
               diff
               (ztree-diff-node-different child)))))
    (ztree-diff-node-set-different node diff)))

(defun ztree-diff-node-update-all-parents-diff (node)
  "Recursively update all parents diff status for the NODE."
  (let ((parent node))
    (while (setq parent (ztree-diff-node-parent parent))
      (ztree-diff-node-update-diff-from-children parent))))


(defun ztree-diff-model-update-diff (old new)
  "Get the diff status depending if OLD or NEW is not nil."
  (if new
      (if (or (not old)
              (eq old 'new))
          new
        old)
    old))

(defun ztree-diff-node-traverse (parent path1 path2)
  "Traverse 2 paths creating the list nodes with PARENT defined and diff status.
Function traversing 2 paths PATH1 and PATH2 returning the list where the
first element is the difference status (nil, 'diff, 'new') and
the rest is the combined list of nodes."
  (let ((list1 (ztree-directory-files path1))
        (list2 (ztree-directory-files path2))
        (different-dir nil)
        (result nil))
    (ztree-diff-model-update-wait-message)
    ;; first - adding all entries from left directory
    (dolist (file1 list1)
      ;; for every entry in the first directory
      ;; we are creating the node
      (let* ((simple-name (ztree-file-short-name file1))
             (isdir (file-directory-p file1))
             (children nil)
             (different nil)
             ;; create the current node to be set as parent to
             ;; subdirectories
             (node (ztree-diff-node-create parent file1 nil simple-name simple-name nil nil))
             ;; 1. find if the file is in the second directory and the type
             ;;    is the same - i.e. both are directories or both are files
             (file2 (ztree-find list2
                                #'(lambda (x) (and (string-equal (ztree-file-short-name x)
                                                                 simple-name)
                                                   (eq isdir (file-directory-p x)))))))
        ;; 2. if it is not in the second directory, add it as a node
        (if (not file2)
            (progn
              ;; 2.1 if it is a directory, add the whole subtree
              (when (file-directory-p file1)
                (setq children (ztree-diff-model-subtree node file1 'left)))
              ;; 2.2 update the difference status for this entry
              (setq different 'new))
          ;; 3. if it is found in second directory and of the same type
          ;; 3.1 if it is a file
          (if (not (file-directory-p file1))
              ;; 3.1.1 set difference status to this entry
              (setq different (if (ztree-diff-model-files-equal file1 file2) nil 'diff))
            ;; 3.2 if it is the directory
            ;; 3.2.1 get the result of the directories comparison together with status
            (let ((traverse (ztree-diff-node-traverse node file1 file2)))
              ;; 3.2.2 update the difference status for whole comparison from
              ;;       difference result from the 2 subdirectories comparison
              (setq different (car traverse))
              ;; 3.2.3 set the children list from the 2 subdirectories comparison
              (setq children (cdr traverse)))))
        ;; update calculated parameters of the node
        (ztree-diff-node-set-right-path node file2)
        (ztree-diff-node-set-children node children)
        (ztree-diff-node-set-different node different)
        ;; 2.3 update difference status for the whole comparison
        ;; depending if the node should participate in overall result
        (unless (ztree-diff-model-ignore-p node)
          (setq different-dir (ztree-diff-model-update-diff different-dir different)))
        ;; push the created node to the result list
        (push node result)))
    ;; second - adding entries from the right directory which are not present
    ;; in the left directory
    (dolist (file2 list2)
      ;; for every entry in the second directory
      ;; we are creating the node
      (let* ((simple-name (ztree-file-short-name file2))
             (isdir (file-directory-p file2))
             (children nil)
             ;; create the node to be added to the results list
             (node (ztree-diff-node-create parent nil file2 simple-name simple-name nil 'new))
             ;; 1. find if the file is in the first directory and the type
             ;;    is the same - i.e. both are directories or both are files
             (file1 (ztree-find list1
                                #'(lambda (x) (and (string-equal (ztree-file-short-name x)
                                                                 simple-name)
                                                   (eq isdir (file-directory-p x)))))))
        ;; if it is not in the first directory, add it as a node
        (unless file1
          ;; if it is a directory, set the whole subtree to children
          (when (file-directory-p file2)
            (setq children (ztree-diff-model-subtree node file2 'right)))
          ;; set calculated children to the node
          (ztree-diff-node-set-children node children)
          ;; update the different status for the whole comparison
          ;; depending if the node should participate in overall result
          (unless (ztree-diff-model-ignore-p node)
            (setq different-dir (ztree-diff-model-update-diff different-dir 'new)))
          ;; push the created node to the result list
          (push node result))))
    ;; result is a pair: difference status and nodes list
    (cons different-dir result)))

(defun ztree-diff-model-create (dir1 dir2 &optional ignore-p)
  "Create a node based on DIR1 and DIR2.
IGNORE-P is the optional filtering function, taking node as
an argument, which determines if the node should be excluded
from comparison."
  (unless (file-directory-p dir1)
    (error "Path %s is not a directory" dir1))
  (unless (file-directory-p dir2)
    (error "Path %s is not a directory" dir2))
  (setf ztree-diff-model-ignore-fun ignore-p)
  (setq ztree-diff-model-wait-message (concat "Comparing " dir1 " and " dir2 " ..."))
  (let* ((model
          (ztree-diff-node-create nil dir1 dir2
                                  (ztree-file-short-name dir1)
                                  (ztree-file-short-name dir2)
                                  nil
                                  nil))
         (traverse (ztree-diff-node-traverse model dir1 dir2)))
    (ztree-diff-node-set-children model (cdr traverse))
    (ztree-diff-node-set-different model (car traverse))
    (message "Done.")
    model))

(defun ztree-diff-model-update-node (node)
  "Refresh the NODE."
  (setq ztree-diff-model-wait-message
        (concat "Updating " (ztree-diff-node-short-name node) " ..."))
  (let ((traverse (ztree-diff-node-traverse node
                                            (ztree-diff-node-left-path node)
                                            (ztree-diff-node-right-path node))))
    (ztree-diff-node-set-children node (cdr traverse))
    (ztree-diff-node-set-different node (car traverse))
    (message "Done.")))



(provide 'ztree-diff-model)

;;; ztree-diff-model.el ends here