[elpa] externals/assess 890906bfcb 17/95: Interface written as single overloaded function.

[ELPA Syncer]

branch: externals/assess
commit 890906bfcb7b07dde82673a16c312737ec1cde00
Author: Phillip Lord <phillip.lord@newcastle.ac.uk>
Commit: Phillip Lord <phillip.lord@newcastle.ac.uk>

    Interface written as single overloaded function.
    
    Previously, sisyphus had lots of independent functions for each type,
    but this was starting to get unmanageable. It now has a single function
    which does things appropriate for the type of argument passed to it.
---
 sisyphus.el           | 133 ++++++++++++++++++++------------------------------
 test/sisyphus-test.el |  55 ++++++++++++++++-----
 2 files changed, 96 insertions(+), 92 deletions(-)

diff --git a/sisyphus.el b/sisyphus.el
index 356f89ac61..60b84be10a 100644
--- a/sisyphus.el
+++ b/sisyphus.el
@@ -62,14 +62,16 @@
 
 
 ;; #+begin_src emacs-lisp
-(defun sisyphus--ert-pp-with-indentation-and-newline (orig object)
-  (let ((pp-escape-newlines nil))
-    (funcall orig object)))
-
-(advice-add
- 'ert--pp-with-indentation-and-newline
- :around
- #'sisyphus--ert-pp-with-indentation-and-newline)
+(when (= emacs-major-version 24)
+
+  (defun sisyphus--ert-pp-with-indentation-and-newline (orig object)
+    (let ((pp-escape-newlines nil))
+      (funcall orig object)))
+
+  (advice-add
+   'ert--pp-with-indentation-and-newline
+   :around
+   #'sisyphus--ert-pp-with-indentation-and-newline))
 ;; #+end_src
 
 
@@ -91,7 +93,24 @@
 ;; How do do this cleanly? Apply patch to ert.el?
 
 
-
+;; #+begin_src emacs-lisp
+(defun sisyphus-to-string (x)
+  "Turn X into a string in a type appropriate way."
+  (pcase x
+   ((pred stringp) x)
+   ((pred bufferp) (m-buffer-at-string x))
+   (`(:buffer ,b) (sisyphus-to-string (get-buffer-create b)))
+   (`(:file ,f)
+    (with-temp-buffer
+      (insert-file-contents f)
+      (buffer-string)))
+   ;; error condition
+   (_ (error "Type not recognised"))))
+
+(defun sisyphus-file (f)
+  "Add type data to F marking it as a file."
+  `(:file ,f))
+;; #+end_src
 
 ;; *** String Comparision
 
@@ -150,79 +169,35 @@ print any messages!"
   ;; We could do a bit more here.
   (format "String :%s:%s: are not equal."))
 
-(defun sisyphus-explain-string= (a b)
-  "Compare strings and return an explanation."
-  (cond
-   ((string= a b)
-    t)
-   ((executable-find "diff")
-    (sisyphus--explainer-diff-string= a b))
-   (t
-    (sisyphus--explainer-simple-string= a b))))
-
-(put 'string= 'ert-explainer 'sisyphus-explain-string=)
-;; #+end_src
-
-;;; *** String to buffer
-
-;; #+begin_src emacs-lisp
-(defun sisyphus-buffer-string= (buffer string)
-  (string=
-   (m-buffer-at-string buffer)
-   string))
-
-(defun sisyphus-explain-buffer-string= (buffer string)
-  (sisyphus-explain-string=
-   (m-buffer-at-string buffer)
-   string))
+(defun sisyphus= (a b)
+  "Compare A and B to see if they are the same.
 
-(put 'sisyphus-buffer-string=
-     'ert-explainer
-     'sisyphus-explain-buffer-string=)
-;; #+end_src
-
-
-;; Compare buffer to buffer
-;; #+begin_src emacs-lisp
-(defun sisyphus-buffer= (a b)
+Equality in this sense means compare the contents in a way which
+is appropriate for the type of the two arguments. So, if they are
+strings, the compare strings, if buffers, then compare the buffer
+contents and so on."
   (string=
-   (m-buffer-at-string a)
-   (m-buffer-at-string b)))
-
-(defun sisyphus-explain-buffer= (a b)
-  (sisyphus-explain-string=
-   (m-buffer-at-string a)
-   (m-buffer-at-string b)))
-
-(put 'sisyphus-buffer=
-     'ert-explainer
-     'sisyphus-explain-buffer=)
+   (sisyphus-to-string a)
+   (sisyphus-to-string b)))
+
+(defun sisyphus-explain= (a b)
+  "Compare A and B and return an explanation.
+See `sisyphus=' for more information."
+  (let ((a (sisyphus-to-string a))
+        (b (sisyphus-to-string b)))
+    (cond
+     ((sisyphus= a b)
+      t)
+     ((executable-find "diff")
+      (sisyphus--explainer-diff-string= a b))
+     (t
+      (sisyphus--explainer-simple-string= a b)))))
+
+(put 'sisyphus= 'ert-explainer 'sisyphus-explain=)
 ;; #+end_src
 
-;; Compare string to file
-(defun sisyphus-file-string= (file string)
-  (string=
-   (with-temp-buffer
-     (insert-file-contents file)
-     (buffer-string))
-   string))
-
-(defun sisyphus-explain-file-string= (file string)
-  (sisyphus-explain-string=
-   (with-temp-buffer
-     (insert-file-contents file)
-     (buffer-string))
-   string))
-
-(put 'sisyphus-file-string=
-     'ert-explainer
-     'sisyphus-explain-file-string=)
-
-;; Compare buffer to file
-
-;; Compare file to file.
 
-;; ** Create buffers
+;; ** create buffers
 
 
 
@@ -250,10 +225,10 @@ print any messages!"
         (current-buffer)))))
 
 (defmacro sisyphus-with-temp-buffers (varlist &rest body)
-  "Bind variables in VARLIST to temp buffers, then eval BODY.
+  "Bind variables in varlist to temp buffers, then eval BODY.
 
 VARLIST is of the same form as a `let' binding. Each element is a
-symbol or a list (SYMBOL VALUEFORMS). Each symbol is bound to a
+symbol or a list (symbol valueforms). Each symbol is bound to a
 buffer generated with `generate-new-buffer'. VALUEFORMS are
 evaluated with the buffer current. Buffers are unconditionally
 killed at the end of the form."
diff --git a/test/sisyphus-test.el b/test/sisyphus-test.el
index a0edcc5574..75611eb165 100644
--- a/test/sisyphus-test.el
+++ b/test/sisyphus-test.el
@@ -50,7 +50,7 @@ This also tests the advice on string=."
       :body
       (lambda ()
         (should
-         (string= "1" "2"))))))))
+         (sisyphus= "1" "2"))))))))
 
 (ert-deftest sisyphus-test--string= ()
   "Test that string= works after explanation added."
@@ -72,19 +72,50 @@ This also tests the advice on string=."
    (sisyphus-test--explanation
     (lambda ()
       (should
-       (string= "1" "2"))))))
+       (sisyphus= "1" "2"))))))
+
+(defvar sisyphus-test-hello.txt
+  (sisyphus-file
+   (relative-expand-file-name "../dev-resources/hello.txt")))
+
+(ert-deftest to-string ()
+  (should
+   (equal "hello"
+          (sisyphus-to-string "hello")))
+  (should
+   (with-temp-buffer
+     (equal "hello"
+            (progn
+              (insert "hello")
+              (sisyphus-to-string (current-buffer))))))
+  (should
+   (with-temp-buffer
+     (equal "hello"
+            (progn
+              (insert "hello")
+              (sisyphus-to-string
+               (list
+                :buffer
+                (buffer-name (current-buffer))))))))
+  (should
+   (with-temp-buffer
+     (equal "hello\n"
+            (sisyphus-to-string
+             sisyphus-test-hello.txt))))
+  (should-error
+   (sisyphus-to-string :hello)))
 
 (ert-deftest buffer-string= ()
   (with-temp-buffer
     (insert "hello")
     (should
-     (sisyphus-buffer-string=
+     (sisyphus=
       (current-buffer)
       "hello")))
   (with-temp-buffer
     (insert "goodbye")
     (should-not
-     (sisyphus-buffer-string=
+     (sisyphus=
       (current-buffer)
       "hello")))
   (should
@@ -93,7 +124,7 @@ This also tests the advice on string=."
       (with-temp-buffer
         (insert "goodbye")
         (should
-         (sisyphus-buffer-string=
+         (sisyphus=
           (current-buffer)
           "hello")))))))
 
@@ -104,14 +135,14 @@ This also tests the advice on string=."
        (b
         (insert "hello")))
     (should
-     (sisyphus-buffer= a b)))
+     (sisyphus= a b)))
   (sisyphus-with-temp-buffers
       ((a
         (insert "hello"))
        (b
         (insert "goodbye")))
     (should-not
-     (sisyphus-buffer=
+     (sisyphus=
       a b)))
   (should
    (sisyphus-with-temp-buffers
@@ -120,27 +151,25 @@ This also tests the advice on string=."
      (sisyphus-test--explanation
       (lambda ()
         (should
-         (sisyphus-buffer=
+         (sisyphus=
           a b)))))))
 
-(defvar sisyphus-test-hello.txt
-  (relative-expand-file-name "../dev-resources/hello.txt"))
 
 
 (ert-deftest file-string= ()
   (should
-   (sisyphus-file-string=
+   (sisyphus=
     sisyphus-test-hello.txt
     "hello\n"))
   (should-not
-   (sisyphus-file-string=
+   (sisyphus=
     sisyphus-test-hello.txt
     "goodbye"))
   (should
    (sisyphus-test--explanation
     (lambda ()
       (should
-       (sisyphus-file-string=
+       (sisyphus=
         sisyphus-test-hello.txt
         "goodbye"))))))