1  ;;; dash-x.el --- Description -*- lexical-binding: t; -*-
  2  ;;
  3  ;; Copyright (C) 2024 Benjamin Andresen
  4  ;;
  5  ;; Author: Benjamin Andresen <b@lambda.icu>
  6  ;; Maintainer: Benjamin Andresen <b@lambda.icu>
  7  ;; Created: August 19, 2024
  8  ;; Modified: August 19, 2024
  9  ;; Version: 0.0.1
 10  ;; Package-Requires: ((emacs "24.3"))
 11  ;;
 12  ;; This file is not part of GNU Emacs.
 13  ;;
 14  ;;; Commentary:
 15  ;;
 16  ;;  Description
 17  ;;
 18  ;;; Code:
 19  
 20  (require 'parseedn)
 21  
 22  (defvar dash-x-tests-enabled nil)
 23  (defvar dash-x-tap-command "bb tap")
 24  
 25  (defmacro -comment (&rest _body)
 26    nil)
 27  
 28  (defmacro -tests (&rest body)
 29    "Run a series of ERT tests defined in BODY.
 30  Each test is defined by a series of setup forms followed by a comparison
 31  using the := symbol. The left-hand side of := is the expression to test,
 32  and the right-hand side is the expected result.
 33  
 34  Example usage:
 35  (-tests
 36   (setq x 10)
 37   (setq y 20)
 38   (+ x y) := 30
 39   (- y x) := 10)
 40  
 41  This macro is only active when `dash-x-tests-enabled' is non-nil.
 42  It returns a string summarizing the test results."
 43    (when (bound-and-true-p dash-x-tests-enabled)
 44      (let ((setup-forms '())
 45            (test-forms '())
 46            (test-names '()))
 47        (while body
 48          (let ((form (pop body)))
 49            (if (eq form :=)
 50                (let ((lhs (pop setup-forms))
 51                      (rhs (pop body))
 52                      (test-name (gensym "autogenerated-test-")))
 53                  (push test-name test-names)
 54                  (push `(ert-deftest ,test-name ()
 55                           (should (equal ,lhs ,rhs)))
 56                        test-forms))
 57              (push form setup-forms))))
 58        `(progn
 59           ,@(nreverse setup-forms)
 60           ,@(nreverse test-forms)
 61           (let ((messages '())
 62                 (orig-message (symbol-function 'message)))
 63             (cl-letf (((symbol-function 'message)
 64                        (lambda (format-string &rest args)
 65                          (push (apply #'format format-string args) messages))))
 66               (ert-run-tests-batch '(or ,@(nreverse test-names))))
 67             (let ((result-line (car (-filter (lambda (msg) (s-contains? "Ran " msg))
 68                                              (nreverse messages)))))
 69               (if result-line
 70                   (s-trim result-line)
 71                 "No test results found")))))))
 72  
 73  (defun -tests-enable! ()
 74    (setq dash-x-tests-enabled t))
 75  
 76  (defun -slurp (filename)
 77    (with-temp-buffer
 78      (insert-file-contents filename)
 79      (buffer-substring-no-properties
 80       (point-min)
 81       (point-max))))
 82  
 83  (defun --benchmark (duration-ms f)
 84    (let* ((start (float-time))
 85           (after-first (float-time))
 86           (delta (- after-first start))
 87           (deadline (+ start (/ duration-ms 1000.0)))
 88           (tight-iters (max (/ (/ duration-ms (* delta 1000)) 10) 1)))
 89      (cl-loop
 90       with i = 1
 91       while (< (float-time) deadline)
 92       do (dotimes (_ tight-iters) (funcall f))
 93       do (cl-incf i tight-iters)
 94       finally return
 95       (let* ((final-time (- (float-time) start))
 96              (time-per-call (* (/ final-time (float i)) 1e9)))
 97         (format
 98          "Time per call: %s   Iterations: %d"
 99          (cond
100           ((< time-per-call 1e3) (format "%.0f ns" time-per-call))
101           ((< time-per-call 1e6) (format "%.2f µs" (/ time-per-call 1e3)))
102           ((< time-per-call 1e9) (format "%.2f ms" (/ time-per-call 1e6)))
103           (t (format "%.2f s" (/ time-per-call 1e9))))
104          i)))))
105  
106  (defmacro -time+ (&rest body)
107    "Like `--benchmark', but runs BODY for 2000ms and prints the average
108  time for a single iteration. If the first argument is a number, it's used
109  as the duration in milliseconds. Returns a formatted string with the results."
110    (let* ((duration-and-body
111            (if (numberp (car body))
112                (cons (car body) (cdr body))
113              (cons 2000 body)))
114           (duration (car duration-and-body))
115           (body (cdr duration-and-body)))
116      `(--benchmark ,duration (lambda () ,@body))))
117  
118  (defun -tap> (x)
119    "Sends X to `dash-x-tap-command' which is a command that accepts edn on stdin.
120  Always retuns t."
121    (interactive)
122    (with-temp-buffer
123      (insert (parseedn-print-str x))
124      (shell-command-on-region (point-min) (point-max) dash-x-tap-command))
125    't)
126  
127  (provide 'dash-x)
128  ;;; dash-x.el ends here