(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)