diff options
Diffstat (limited to 'monad/either.scm')
-rw-r--r-- | monad/either.scm | 33 |
1 files changed, 16 insertions, 17 deletions
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) |