feat: either

either.sls

@@ -0,0 +1,119 @@
+;; functional error handling with Either type
+;; initially written by claude 3.7!
+(library (meh either)
+  (export
+   either either?
+   left? right?
+   left-value right-value
+   left right
+   either-value
+   either-map
+   either-bind
+   either-fold
+   either->list
+
+   ;; syntax helpers
+   try-either
+   with-either
+   either-let)
+  (import (chezscheme)
+          (meh match)
+          (meh std))
+
+  ;; Core implementation using tagged records
+  (define-record-type either
+    (fields tag value)
+    (protocol
+     (lambda (new)
+       (lambda (tag value)
+         (unless (memq tag '(left right))
+           (assertion-violation 'make-either
+                               "Invalid tag, must be 'left or 'right"
+                               tag))
+         (new tag value)))))
+
+  ;; Constructors and predicates
+  (define (left value)
+    (make-either 'left value))
+
+  (define (right value)
+    (make-either 'right value))
+
+  (define (left? e)
+    (and (either? e) (eq? (either-tag e) 'left)))
+
+  (define (right? e)
+    (and (either? e) (eq? (either-tag e) 'right)))
+
+  ;; Accessors with safety checks
+  (define (left-value e)
+    (if (left? e)
+        (either-value e)
+        (assertion-violation 'left-value "Expected a Left value" e)))
+
+  (define (right-value e)
+    (if (right? e)
+        (either-value e)
+        (assertion-violation 'right-value "Expected a Right value" e)))
+
+  ;; Functional operations
+  (define (either-map f e)
+    (if (right? e)
+        (right (f (right-value e)))
+        e))
+
+  (define (either-bind e f)
+    (if (right? e)
+        (f (right-value e))
+        e))
+
+  (define (either-fold left-f right-f e)
+    (if (left? e)
+        (left-f (left-value e))
+        (right-f (right-value e))))
+
+  (define (either->list e)
+    (either-fold
+     (lambda (v) '())
+     (lambda (v) (list v))
+     e))
+
+  ;; Add pattern matching support
+  (define-record-equality! either)
+  (define-record-pattern! either)
+
+  ;; Define pattern expanders for left and right
+  (define-pattern (left pat) (either 'left pat))
+
+  (define-pattern (right pat) (either 'right pat))
+
+  ;; Exception handling helper - now with explicit condition handling
+  (define-syntax try-either
+    (syntax-rules ()
+      [(_ expr)
+       (guard (exn
+               [(condition? exn) (left exn)])
+              (right expr))]))
+
+  ;; Syntax for monadic composition
+  (define-syntax either-let
+    (syntax-rules ()
+      [(_ () expr) (right expr)]
+      [(_ ([var val]) expr)
+       (either-bind val (lambda (var) (right expr)))]
+      [(_ ([var val] [var2 val2] ...) expr)
+       (either-bind val
+                   (lambda (var)
+                     (either-let ([var2 val2] ...) expr)))]))
+
+  ;; Syntax for unwrapping either values with early return on error
+  (define-syntax with-either
+    (syntax-rules ()
+      [(_ default [pat expr])
+       (match expr
+         [(right pat) pat]
+         [_ default])]
+      [(_ default [pat expr] [pat2 expr2] ...)
+       (match expr
+         [(right pat) (with-either default [pat2 expr2] ...)]
+         [_ default])])))