From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Artur Malabarba Newsgroups: gmane.emacs.devel Subject: [ELPA] New package: validate.el Date: Mon, 18 Apr 2016 03:42:41 -0300 Message-ID: Reply-To: bruce.connor.am@gmail.com NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=UTF-8 X-Trace: ger.gmane.org 1460961806 15801 80.91.229.3 (18 Apr 2016 06:43:26 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Mon, 18 Apr 2016 06:43:26 +0000 (UTC) To: emacs-devel Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Mon Apr 18 08:43:25 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 1as2u4-00080e-CU for ged-emacs-devel@m.gmane.org; Mon, 18 Apr 2016 08:43:24 +0200 Original-Received: from localhost ([::1]:59603 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1as2u0-00087V-P5 for ged-emacs-devel@m.gmane.org; Mon, 18 Apr 2016 02:43:20 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:46607) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1as2tj-00083D-SL for emacs-devel@gnu.org; Mon, 18 Apr 2016 02:43:05 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1as2ti-00037W-6A for emacs-devel@gnu.org; Mon, 18 Apr 2016 02:43:03 -0400 Original-Received: from mail-yw0-x243.google.com ([2607:f8b0:4002:c05::243]:33972) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1as2ti-00037E-03 for emacs-devel@gnu.org; Mon, 18 Apr 2016 02:43:02 -0400 Original-Received: by mail-yw0-x243.google.com with SMTP id i22so34074ywc.1 for ; Sun, 17 Apr 2016 23:43:01 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=mime-version:reply-to:sender:from:date:message-id:subject:to; bh=V0xvpJCfqfTeFqV43lEijMYhQlm1IHFq88tFqM3Nn60=; b=gzK3xzlx6LfDE8YPWGHcYAjVd9DyWNxfgpYXb+KHwf99W51hL2kg8YRIJpKEaVHjQl V25Zr+6i/1nxJuGABP4CDgyhiuSLYfm32dwdoseF8VUHqIxM58gbGh4IbI4YVF86j6wG fuSNX3k0epUSpeIA5Aubr3ROGvnk1oEM3sjBxMD4g+p6zlpEx+/9C6I1KrPfGwR8rxiZ UgekZTQlRcvsAwHCgQS5aKmenrzwbkICqv8ZXpdBVPPGOyWPh9uTEu+U+3U6bNkRl0nS Wx63YJ4GxOi34eDmq9ztL9s6OGpWUmYrtv2ONBZo3wQV8qhplOZuV07S7JcNeEDC069O bELA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20130820; h=x-gm-message-state:mime-version:reply-to:sender:from:date :message-id:subject:to; bh=V0xvpJCfqfTeFqV43lEijMYhQlm1IHFq88tFqM3Nn60=; b=ANMD1pK5UfXSwTUTRxl2SZTx0TBTn7N6uN+efIKk9zYzJE2Up/sMYiPDBIClGYtBYR vqml910E+q5VAvuB+u64FAIwmgrtVzD4Ru9vYPQGvsraNoKAqpvP3zTA981EPXFLGHtF tetvf4ZPOMK7p6OuBdCUi+WlQw8G6hEwi0Qq7nkvx7MRXgTz93mgUCnCvyvqJ1Izicnl JqVbZ0Dpuo8CeJov3ZFEXnY2/MVCTSeoneHMjbef5a+t+YndOUcn98XZgwbtLCpUfz72 H4fBXCWdbuB/qdEe9rV54iyT1q94KoD+lra51AWdj5U5eRktPXVBbgAaCTglfbxWDSDk Mqqw== X-Gm-Message-State: AOPr4FVpStlghwCPOzb+ivOWZ92E3LbFtW8ORI/hTL2Ebv46QSIoip9PymcljN/SASuEIk+JIw6zZuojLqxeKA== X-Received: by 10.13.247.4 with SMTP id h4mr20418387ywf.15.1460961781106; Sun, 17 Apr 2016 23:43:01 -0700 (PDT) Original-Received: by 10.129.77.9 with HTTP; Sun, 17 Apr 2016 23:42:41 -0700 (PDT) X-Google-Sender-Auth: wLGwINjQz3VKKUS3UGo_9EYvGTM X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 2607:f8b0:4002:c05::243 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:203030 Archived-At: 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