ADD totall haskell ripoff library

local/lib/either/either.el

@@ -0,0 +1,118 @@
+;;; either.el --- This or that -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2022  Nathan Dwarshuis
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Lisp implementation (kinda) of Data.Either from Haskell
+
+;;; Code:
+
+(defmacro either (key data)
+  "Make an either type.
+
+KEY is either :left or :right and DATA is whatever goes in the
+left/right slot."
+  (pcase key
+    ((or :left :right) `(list ,key ,data))
+    (e (error "Invalid status key: %s" key))))
+
+(defmacro either>>= (either form)
+  "Bind EITHER to FORM where the right slot is bound to 'it'."
+  (declare (indent 1))
+  `(pcase ,either
+     (`(:left ,_) ,either)
+     (`(:right ,it) ,form)
+     (e (error "Learn to use monads, dummy; this isn't one: %s" e))))
+
+(defun either-is-left-p (either)
+  "Return t if EITHER is a left."
+  (eq (car either) :left))
+
+(defun either-is-right-p (either)
+  "Return t if EITHER is a right."
+  (eq (car either) :right))
+
+(defmacro either<$> (either form)
+  "Map FORM over EITHER where 'it' is bound to the right slot."
+  (declare (indent 1))
+  (let ((b (make-symbol "--bs")))
+    `(let ((,b ,either))
+       (pcase ,b
+         (`(:left ,_) ,b)
+         (`(:right ,it) (either :right ,form))
+         (e (error "Learn to use functors, dummy; this isn't one: %s" e))))))
+
+(defmacro either-from-right (either default &rest body)
+  "Apply BODY to the right slot of EITHER.
+
+If EITHER is right, return result of FORM where the right slot is
+bound to 'it'. Return DEFAULT otherwise."
+  (declare (indent 2))
+  `(pcase ,either
+     (`(:left ,_) ,default)
+     (`(:right ,it) ,@body)
+     (e (error "Not an either: %s" e))))
+
+(defmacro either-from-left (either default &rest body)
+  "Apply BODY to the left slot of EITHER.
+
+If EITHER is left, return result of FORM where the left slot is
+bound to 'it'. Return DEFAULT otherwise."
+  (declare (indent 2))
+  `(pcase ,either
+     (`(:left ,it) ,@body)
+     (`(:right ,_) ,default)
+     (e (error "Not an either: %s" e))))
+
+(defun either-from-right* (either default fun)
+  (declare (indent 2))
+  (either-from-right either default (funcall fun it)))
+
+(defun either-from-left* (either default fun)
+  (declare (indent 2))
+  (either-from-left either default (funcall fun it)))
+
+(defmacro either-from (either left-form right-form)
+  "Apply forms to the left or right slot of EITHER.
+
+Use LEFT-FORM or RIGHT-FORM is EITHER is left or right
+respectively where 'it' is bound to whatever is in the the
+left/right slots."
+  (declare (indent 1))
+  `(pcase ,either
+     (`(:left ,it) ,left-form)
+     (`(:right ,it) ,right-form)
+     (e (error "Not an either: %s" e))))
+
+(defun either-lefts (eithers)
+  "Return all left values from EITHERS."
+  (let (acc)
+    (--each eithers
+      (when (either-is-left-p it)
+        (!cons (cadr it) acc)))
+    (nreverse acc)))
+
+(defun either-rights (eithers)
+  "Return all right values from EITHERS."
+  (let (acc)
+    (--each eithers
+      (when (either-is-right-p it)
+        (!cons (cadr it) acc)))
+    (nreverse acc)))
+
+(provide 'either)
+;;; either.el ends here