;;; shm-slot.el --- Slots for shm

;; Copyright (c) 2014 Chris Done. All rights reserved.

;; This file 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, or (at your option)
;; any later version.

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

;;; Code:

(require 'shm-evaporate)
(require 'shm-layout)

(require 'cl)

(defun shm/jump-to-slot ()
  "Jump to the next skeleton slot."
  (interactive)
  (let ((os (sort (remove-if-not (lambda (o) (overlay-get o 'shm-evaporate-overlay))
                                 (overlays-in (point) (point-max)))
                  (lambda (a b)
                    (< (overlay-start a)
                       (overlay-start b))))))
    (when os
      (if (= (overlay-start (car os))
             (point))
          (when (cadr os)
            (goto-char (overlay-start (cadr os))))
        (goto-char (overlay-start (car os)))))))

(defun shm/jump-to-previous-slot ()
  "Jump to the previous skeleton slot."
  (interactive)
  (let ((os (sort (remove-if-not (lambda (o) (overlay-get o 'shm-evaporate-overlay))
                                 (overlays-in (point-min) (point)))
                  (lambda (a b)
                    (> (overlay-start a)
                       (overlay-start b))))))
    (when os
      (if (= (overlay-start (car os))
             (point))
          (when (cadr os)
            (goto-char (overlay-start (cadr os))))
        (goto-char (overlay-start (car os)))))))

(defun shm/insert-undefined ()
  "Insert undefined."
  (interactive)
  (save-excursion
    (let ((point (point)))
      (shm-insert-string "undefined")
      (shm-evaporate point (point)))))

(defun shm-auto-insert-do ()
  "Insert template

do {undefined}
   {undefined}
"
  (insert " ")
  (let ((point (point))
        (column (current-column)))
    (insert "undefined")
    (cond
     ((bound-and-true-p structured-haskell-repl-mode)
      (forward-word -1)
      (shm/reparse)
      (save-excursion
        (shm-evaporate (point) (+ (point) (length "undefined")))))
     (t (newline)
        (indent-to column)
        (let ((next-point (point)))
          (insert "undefined")
          (goto-char point)
          (shm/reparse)
          (save-excursion
            (shm-evaporate (point) (+ (point) (length "undefined")))
            (goto-char next-point)
            (shm-evaporate (point) (+ (point) (length "undefined")))))))))

(defun shm-auto-insert-case ()
  "Insert template

case {undefined} of
  {_} -> {undefined}
"
  (let ((start (save-excursion (forward-char -1)
                               (search-backward-regexp "[^a-zA-Z0-9_]")
                               (forward-char 1)
                               (point)))
        (template (if (bound-and-true-p structured-haskell-repl-mode)
                      "case undefined of _ -> undefined"
                    "case undefined of\n  _ -> undefined")))
    (shm-adjust-dependents (point) (- start (point)))
    (delete-region start (point))
    (shm-adjust-dependents (point) (length (car (last (split-string template "\n")))))
    (shm-insert-indented
     (lambda ()
       (insert template)))
    (forward-char 5)
    (shm/reparse)
    (save-excursion
      (shm-evaporate (point) (+ (point) (length "undefined")))
      (search-forward-regexp "_" nil nil 1)
      (shm-evaporate (1- (point)) (point))
      (forward-char 4)
      (shm-evaporate (point) (+ (point) (length "undefined"))))))

(defun shm-auto-insert-if ()
  "Insert template

if {undefined}
   then {undefined}
   else {undefined}

or

if {undefined} then {undefined} else {undefined}

if inside parentheses."
  (let ((start (save-excursion (forward-char -1)
                               (search-backward-regexp "[^a-zA-Z0-9_]")
                               (forward-char 1)
                               (point)))
        (template (if (bound-and-true-p structured-haskell-repl-mode)
                      "if undefined then undefined else undefined"
                    "if undefined\n   then undefined\n   else undefined")))
    (shm-adjust-dependents (point) (- start (point)))
    (delete-region start (point))
    (shm-adjust-dependents (point) (length (car (last (split-string template "\n")))))
    (shm-insert-indented
     (lambda ()
       (insert template)))
    (forward-char 3)
    (save-excursion
      (shm-evaporate (point) (+ (point) (length "undefined")))
      (search-forward-regexp "then ")
      (shm-evaporate (point) (+ (point) (length "undefined")))
      (search-forward-regexp "else ")
      (shm-evaporate (point) (+ (point) (length "undefined"))))))

(defun shm-auto-insert-let ()
  "Insert template

let | in {undefined}"
  (delete-region (- (point) 3) (point))
  ;; If needs to be nested this way. Don't change it.
  (cl-flet
      ((evaporate-in ()
                     (forward-char 4)
                     (save-excursion
                       (forward-word)
                       (forward-char 1)
                       (shm-evaporate (point) (+ (point) (length "undefined"))))))
    (if (bound-and-true-p structured-haskell-repl-mode)
        (let ((points (shm-decl-points)))
          (if points
              (if (= (point) (car points))
                (progn (shm-insert-indented
                        (lambda () (insert "let _ = undefined")))
                       (search-forward "_")
                       (shm-evaporate (1- (point)) (point))
                       (forward-word 1)
                       (forward-word -1)
                       (shm-evaporate (point) (+ (point) (length "undefined")))
                       (search-backward "_"))
              (progn (shm-insert-indented
                      (lambda () (insert "let  in undefined")))
                     (evaporate-in)))
            (insert "let ")))
      (progn (shm-insert-indented
              (lambda () (insert "let \nin undefined")))
             (evaporate-in))))
  (shm/reparse))

(defun shm-auto-insert-module ()
  "Insert template

module | where"
  (insert "  where")
  (backward-word 1)
  (forward-char -1))

(provide 'shm-slot)