blob: c8f64879cdbf81ef11226b32f2ba811e3321aaf5 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
|
(define-module (monad either)
#:use-module (oop goops)
#:use-module (monad)
#:export (left right)
#:re-export (>>= >> return)
)
(define-class <either> ()
(slot #:init-keyword #:slot
#:getter unwrap-either))
(define-class <left> (<either>))
(define-class <right> (<either>))
(define (left val)
"Error values"
(make <left> #:slot val))
(define (right val)
"Good values"
(make <right> #:slot val))
(define-method (write (this <either>) port)
(format port "#<~a ~s>" (class-name (class-of this)) (unwrap-either this)))
(define-method (>>= (this <left>) (_ <procedure>)) this)
(define-method (>>= (this <right>) (proc <procedure>))
(proc (unwrap-either this)))
(define-method (return (_ <either>)) right)
|
