;;; Commentary:
;;
;; Your classical optional (Maybe) monad.
;; It has the constructors @code{just} and @code{nothing}.
;;
;;; Code:

(define-module (monad optional)
  #:use-module (oop goops)
  #:use-module (monad)
  #:export (from-just
            from-maybe wrap-maybe
            nothing just
            nothing? just?)
  #:re-export (>>= >> return))

(define-class <optional> ())
(define-class <nothing> (<optional>))
(define-class <just> (<optional>)
  (slot #:init-keyword #:slot
        #:getter from-just))

(define (nothing) (make <nothing>))

(define (just obj) (make <just> #:slot obj))

(define (nothing? this)
  (is-a? this <nothing>))

(define (just? this)
  (is-a? this <just>))

;; Returns default if maybe-val is nothing, otherwise
;; the value embedded in maybe-val
(define-method (from-maybe default (_ <nothing>)) default)
(define-method (from-maybe _ (m <just>)) (from-just m))

(define (wrap-maybe proc)
  "Wraps a function in an optional monad, where #f returns are translated to
nothing."
  (lambda values
   (let ((v (apply proc values)))
     (if v (just v) (nothing)))))

(define-method (write (this <just>) port)
  (format port "#<just ~s>" (from-just this)))
(define-method (write (this <nothing>) port)
  (format port "#<nothing>"))

(define-method (>>= (_ <nothing>) (f <procedure>)) (nothing))
(define-method (>>= (j <just>)    (f <procedure>)) (f (from-just j)))

(define-method (return (a <optional>)) just)

(define (curry arg-count proc . collected)
  (if (zero? arg-count)
      (apply proc collected)
      (lambda (x) (apply curry (1- arg-count) proc x collected))))

(define-method (equal? (a <optional>)
                       (b <optional>))
  (or (and (nothing? a) (nothing? b))
      (from-maybe #f #!curly-infix { {(curry 2 equal?) <$> a} <*> b })))