;;; safe-eval.el --- Evaluation of Safe Emacs Lisp   -*- lexical-binding: t; -*-

;; Copyright (C) 2022  Philip Kaludercic

;; Author: Philip Kaludercic <philipk@posteo.net>
;; Created: 15Oct22
;; Keywords: lisp

;; 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/>.

;;; Commentary:

;; An evaluator for safe Emacs Lisp code.

;;; Code:

(eval-when-compile (require 'pcase))
(require 'cl-lib)
(require 'seq)
(require 'macroexp)

(cl-defgeneric safe-eval-p (form)
  "Return non-nil if it is safe to evaluate FORM.
A FORM is safe if it is not a function call, has no side-effects
or a method has been defined to verify its safety."
  (:method :around (form)
	   "Macroexpand FORM before testing for safety."
	   (cl-call-next-method (macroexpand-all form)))
  ;; Some basic logic
  (:method
   ((form (head if)))
   "A `if' FORM is safe if all arguments are safe."
   (pcase-let ((`(if ,(pred safe-eval-p) ,(pred safe-eval-p) . ,else) form))
     (seq-every-p #'safe-eval-p else)))
  (:method
   ((form (head when)))
   "A `when' FORM is safe if all arguments are safe."
   (pcase-let ((`(when ,(pred safe-eval-p) . ,body) form))
     (seq-every-p #'safe-eval-p body)))
  (:method
   ((form (head unless)))
   "A `unless' FORM is safe if all arguments are safe."
   (pcase-let ((`(unless ,(pred safe-eval-p) . ,body) form))
     (seq-every-p #'safe-eval-p body)))
  ;; Common state modifiers
  (:method
   ((form (head setq)))
   "A `setq' FORM is safe the new value is a safe value."
   (pcase-let ((`(setq ,var ,val) form))
     (and (safe-eval-p val)
	  (safe-local-variable-p var val))))
  (:method
   ((form (head add-hook)))
   "A form with `add-hook' must modify a hook locally."
   (pcase-let* ((`(add-hook ',hook
			    ,(or `#',func `',func)
			    ,(pred macroexp-const-p)
			    ,(and (pred macroexp-const-p)
				  (pred identity)))
		 form)
		(new-hook (cons func (symbol-value hook))))
     (and (safe-local-variable-p hook new-hook)
	  (macroexp-const-p func))))
  (:method
   ((form (head add-to-list)))
   "A `add-to-hook' FORM is safe the new list is has a safe value."
   (pcase-let* ((`(add-to-list ',list-var ,element ,append)
		 form)
		(old-list (symbol-value list-var))
		(new-list (if append
			      (append old-list (list element))
			    (cons element old-list))))
     ;; FIXME: `new-list' contains `element' before evaluation.
     (and (safe-local-variable-p list-var new-list)
	  (safe-eval-p element)
	  (macroexp-const-p append))))
  ;; ;; Fallback
  (:method
   ((form t))
   "A fallback handler to check if FORM is side-effect free."
   (or (not (consp form))
       (and (get (car form) 'side-effect-free)
	    (seq-every-p #'safe-eval-p (cdr form))))))

;;;###autoload
(defun safe-eval (form)
  "Evaluate FORM is it is safe per `safe-eval-p'.
If it is not safe, it will be silently ignored."
  (when (safe-eval-p form)
    (eval form t)))

;;;###autoload
(defun safe-eval-file (filename)
  "Evaluate the safe contents of FILENAME.
All files deemed unsafe by `safe-eval-p' are silently ignored.'"
  (with-temp-buffer
    (insert-file-contents filename)
    (while (not (eobp))
      (safe-eval (read (current-buffer))))))

(provide 'safe-eval)
;;; safe-eval.el ends here