From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: phillip.lord@russet.org.uk (Phillip Lord) Newsgroups: gmane.emacs.devel Subject: Re: [ELPA] New package: validate.el Date: Mon, 18 Apr 2016 15:17:19 +0100 Message-ID: <8760vft30w.fsf@russet.org.uk> References: NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: ger.gmane.org 1460989078 31328 80.91.229.3 (18 Apr 2016 14:17:58 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Mon, 18 Apr 2016 14:17:58 +0000 (UTC) Cc: emacs-devel To: Artur Malabarba Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Mon Apr 18 16:17:48 2016 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1as9zo-0007O1-50 for ged-emacs-devel@m.gmane.org; Mon, 18 Apr 2016 16:17:48 +0200 Original-Received: from localhost ([::1]:38735 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1as9zn-0007ol-BS for ged-emacs-devel@m.gmane.org; Mon, 18 Apr 2016 10:17:47 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:50772) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1as9zS-0007lc-MA for emacs-devel@gnu.org; Mon, 18 Apr 2016 10:17:28 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1as9zN-0005F8-Oa for emacs-devel@gnu.org; Mon, 18 Apr 2016 10:17:26 -0400 Original-Received: from cloud103.planethippo.com ([31.216.48.48]:55220) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1as9zN-0005D9-Cq for emacs-devel@gnu.org; Mon, 18 Apr 2016 10:17:21 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=russet.org.uk; s=default; h=Content-Type:MIME-Version:Message-ID: In-Reply-To:Date:References:Subject:Cc:To:From; bh=MLj+R6EnHjZ811q998D26gpxCvonMIju3eTxCWIyMo4=; b=wIrzaf4pxRG+YyJLzRReC6gdW8 UVojF3CCudCvyv8G9h0VhUayhwgVuBVlzHJvqXuSpOT+ottvNVARbomYviv39WRJd7L3ZklATo7tz gtjm8Nv3Kw3cnErq3s1g16CjlIXZSSL0ofRnqQMEwFPlcAZkdoUPdbLes5uyQkY010Etn3udO3IKU Lr33VYeTuRpQ6ODYKHrvDA8001DtS6QievHoZUdpPB9O2+lsZsXHN1gevIEEbC8XjhBjZKnoyEYI5 tts2IpqgEMc7hHvOoahRIv8nZxzBxpQtCJRUaCFzrOYkfynwN1yuRjN+mPvCuJ7x0575YpNzJHw9g W3hh68kQ==; Original-Received: from janus-nat-128-240-225-60.ncl.ac.uk ([128.240.225.60]:34788 helo=russet.org.uk) by cloud103.planethippo.com with esmtpsa (TLSv1.2:DHE-RSA-AES128-SHA:128) (Exim 4.86_1) (envelope-from ) id 1as9zM-002Jae-AF; Mon, 18 Apr 2016 15:17:20 +0100 In-Reply-To: (Artur Malabarba's message of "Mon, 18 Apr 2016 03:42:41 -0300") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/25.0.92 (gnu/linux) X-AntiAbuse: This header was added to track abuse, please include it with any abuse report X-AntiAbuse: Primary Hostname - cloud103.planethippo.com X-AntiAbuse: Original Domain - gnu.org X-AntiAbuse: Originator/Caller UID/GID - [47 12] / [47 12] X-AntiAbuse: Sender Address Domain - russet.org.uk X-Get-Message-Sender-Via: cloud103.planethippo.com: authenticated_id: phillip.lord@russet.org.uk X-Authenticated-Sender: cloud103.planethippo.com: phillip.lord@russet.org.uk X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x X-Received-From: 31.216.48.48 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:203042 Archived-At: I've wanted something like this for years, so this is really nice. Can I suggest something like: (validate-setq cider-known-endpoints "whoops") which errors or setq's as appropriate. Phil Artur Malabarba writes: > I've written a package for validating values against custom-types, > while providing useful messages when the validation fails. > I'd like to add it to Elpa (hopefully I'm not reinventing the wheel here). > > Cheers, > Artur > > --- > ;;; validate.el --- Schema validation for Emacs-lisp -*- > lexical-binding: t; -*- > > ;; Copyright (C) 2016 Artur Malabarba > > ;; Author: Artur Malabarba > ;; Keywords: lisp > ;; Package-Requires: ((emacs "24.1") (cl-lib "0.5")) > ;; Version: 0.1 > > ;;; Commentary: > ;; > ;; This library offers two functions that perform schema validation. > ;; Use this is your Elisp packages to provide very informative error > ;; messages when your users accidentally misconfigure a variable. > ;; For instance, if everything is fine, these do the same thing: > ;; > ;; 1. (validate-variable 'cider-known-endpoints) > ;; 2. cider-known-endpoints > ;; > ;; However, if the user has misconfigured this variable, option > ;; 1. will immediately give them an informative error message, while > ;; option 2. won't say anything and will lead to confusing errors down > ;; the line. > ;; > ;; The format and language of the schemas is the same one used in the > ;; `:type' property of a `defcustom'. > ;; > ;; See: (info "(elisp) Customization Types") > ;; > ;; Both functions throw a `user-error' if the value in question > ;; doesn't match the schema, and return the value itself if it > ;; matches. The function `validate-variable' verifies whether the value of a > ;; custom variable matches its custom-type, while `validate-value' checks an > ;; arbitrary value against an arbitrary schema. > ;; > ;; Missing features: `:inline', `plist', `coding-system', `color', > ;; `hook', `restricted-sexp'. > > ;;; License: > ;; > ;; 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 . > > ;;; Code: > (require 'cl-lib) > (require 'seq) > (require 'cus-edit) > > (defun validate--check-list-contents (values schemas) > "Check that all VALUES match all SCHEMAS." > (if (not (= (length values) (length schemas))) > "wrong number of elements" > (seq-find #'identity (seq-mapn #'validate--check values schemas)))) > > (defun validate--check (value schema) > "Return nil if VALUE matches SCHEMA. > If they don't match, return an explanation." > (let ((args (cdr-safe schema)) > (expected-type (or (car-safe schema) schema)) > (props nil)) > (while (and (keywordp (car args)) (cdr args)) > (setq props `(,(pop args) ,(pop args) ,@props))) > (setq args (or (plist-get props :args) > args)) > (let ((r > (cl-labels ((wtype ;wrong-type > (tt) (unless (funcall (intern (format "%sp" tt)) value) > (format "not a %s" tt)))) > ;; TODO: hook (top-level only). > (cl-case expected-type > ((sexp other) nil) > (variable (cond ((wtype 'symbol)) > ((not (boundp value)) "this symbol has > no variable binding"))) > ((integer number float string character symbol function > boolean face) > (wtype expected-type)) > (regexp (cond ((ignore-errors (string-match value "") t) nil) > ((wtype 'string)) > (t "not a valid regexp"))) > (repeat (cond > ((or (not args) (cdr args)) (error "`repeat' > needs exactly one argument")) > ((wtype 'list)) > (t (let ((subschema (car args))) > (seq-some (lambda (v) (validate--check v > subschema)) value))))) > ((const function-item variable-item) (unless (eq value > (car args)) > "not the expected value")) > (file (cond ((wtype 'string)) > ((file-exists-p value) nil) > ((plist-get props :must-match) "file does not exist") > ((not (file-writable-p value)) "file is not > accessible"))) > (directory (cond ((wtype 'string)) > ((file-directory-p value) nil) > ((file-exists-p value) "path is not a > directory") > ((not (file-writable-p value)) > "directory is not accessible"))) > (key-sequence (and (wtype 'string) > (wtype 'vector))) > ;; TODO: `coding-system', `color' > (coding-system (wtype 'symbol)) > (color (wtype 'string)) > (cons (or (wtype 'cons) > (validate--check (car value) (car args)) > (validate--check (cdr value) (cadr args)))) > ((list group) (or (wtype 'list) > (validate--check-list-contents value args))) > (vector (or (wtype 'vector) > (validate--check-list-contents value args))) > (alist (let ((value-type (plist-get props :value-type)) > (key-type (plist-get props :key-type))) > (cond ((not value-type) (error "`alist' needs > a :value-type")) > ((not key-type) (error "`alist' needs a > :key-type")) > ((wtype 'list)) > (t (validate--check value > `(repeat (cons ,key-type > ,value-type))))))) > ;; TODO: `plist' > ((choice radio) (if (not (cdr args)) > (error "`choice' needs at least one > argument") > (let ((gather (mapcar (lambda (x) > (validate--check value x)) args))) > (when (seq-every-p #'identity gather) > (concat "all of the options failed\n " > (mapconcat #'identity > gather "\n ")))))) > ;; TODO: `restricted-sexp' > (set (or (wtype 'list) > (let ((failed (list t))) > (dolist (schema args) > (let ((elem (seq-find (lambda (x) (not > (validate--check x schema))) > value > failed))) > (unless (eq elem failed) > (setq value (remove elem value))))) > (when value > (concat "the following values don't match > any of the options:\n " > (mapconcat (lambda (x) (format > "%s" x)) value "\n ")))))))))) > (when r > (let ((print-length 4) > (print-level 2)) > (format "Looking for `%S' in `%S' failed because:\n%s" > schema value r)))))) > > ;;; Exposed API > ;;;###autoload > (defun validate-value (value schema &optional noerror) > "Check that VALUE matches SCHEMA. > If it matches return VALUE, otherwise signal a `user-error'. > > If NOERROR is non-nil, return t to indicate a match and nil to > indicate a failure." > (let ((report (validate--check value schema))) > (if report > (unless noerror > (user-error report)) > value))) > > ;;;###autoload > (defun validate-variable (symbol &optional noerror) > "Check that SYMBOL's value matches its schema. > SYMBOL must be the name of a custom option with a defined > `custom-type'. If SYMBOL has a value and a type, they are checked > with `validate-value'. NOERROR is passed to `validate-value'." > (let* ((val (symbol-value symbol)) > (type (custom-variable-type symbol))) > (if type > (validate-value val type) > (if noerror val > (error "Variable `%s' has no custom-type." symbol))))) > > (provide 'validate) > ;;; validate.el ends here