(define-module (control monad procedures)
  #:use-module (oop goops)
  #:use-module (srfi srfi-1)            ; concatenate!
  #:export (>> >>= return))

(define-generic return)
(define-method (return (a <top>)) identity)
(define-method (return (a <pair>)) list)

(define-generic >>=)

(define-method (>>= (a <top>) (proc <procedure>))
  (proc a))

(define-method (>>= (this <null>) proc) '())
(define-method (>>= (this <pair>)
                    (proc <procedure>))
  (concatenate! (map proc this)))

(define-generic >>)

(define-method (>> (a <top>) (b <top>))
  (>>= a (lambda args b)))

(define-method (>> (a <null>) (b <null>)) '())
(define-method (>> (a <pair>) (b <null>)) '())
(define-method (>> (a <null>) (b <pair>)) '())
(define-method (>> (a <pair>) (b <pair>))
  (concatenate! (map (const b) a)))

;; bind :: Monad m => m a -> (a -> m b) -> m b
;; return :: Monad m => a -> m a
;; map :: Functor f => (a -> b) -> f a -> f b