From 656fb512bf007abca6a7ac0aef6d035b7d5fce01 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Fri, 24 Jun 2022 04:48:52 +0200
Subject: Rewrote optional and either to use more GOOPS goodness.

---
 monad/either.scm | 33 ++++++++++++++++-----------------
 1 file changed, 16 insertions(+), 17 deletions(-)

(limited to 'monad/either.scm')

diff --git a/monad/either.scm b/monad/either.scm
index c597a60..c8f6487 100644
--- a/monad/either.scm
+++ b/monad/either.scm
@@ -1,30 +1,29 @@
-;;; TODO UNFINISHED
-
-(define-module (data either)
+(define-module (monad either)
   #:use-module (oop goops)
-  #:use-module (ice-9 match))
+  #:use-module (monad)
+  #:export (left right)
+  #:re-export (>>= >> return)
+  )
 
 (define-class <either> ()
-  (slot #:init-keyword #:slot)
-  (dir #:init-keyword #:dir #:init-value 'left))
+ (slot #:init-keyword #:slot
+        #:getter unwrap-either))
+(define-class <left> (<either>))
+(define-class <right> (<either>))
 
 (define (left val)
   "Error values"
-  (make <either> #:slot val #:dir 'left))
+  (make <left> #:slot val))
 
 (define (right val)
   "Good values"
-  (make <either> #:slot val #:dir 'right))
+  (make <right> #:slot val))
 
 (define-method (write (this <either>) port)
-  (format port "[~a ~s]"
-          (slot-ref this 'dir)
-          (slot-ref this 'slot)))
+  (format port "#<~a ~s>" (class-name (class-of this)) (unwrap-either this)))
 
-(define-method (>>= (this <either>)
-                    (proc <procedure>))
-  (case (slot-ref this 'dir)
-    ((left) this)
-    ((right) (match this (($ <either> slot) (proc slot))))))
+(define-method (>>= (this <left>) (_ <procedure>)) this)
+(define-method (>>= (this <right>) (proc <procedure>))
+  (proc (unwrap-either this)))
 
-(define return-either right)
+(define-method (return (_ <either>)) right)
-- 
cgit v1.2.3