mapM and seqM

gistfile1.lisp

(defpackage :monad (:use :cl :optima))
(in-package :monad)

(defun seqM (ms)
  (labels ((rec (ms)
             (match ms
               ((list m)
                (fmap m (lambda (x) (cons x nil))))
               ((cons m ms)
                (bind m (lambda (x)
                          (fmap (rec ms) (lambda (y) (cons x y)))))))))
    (when ms (rec ms))))
    
(defun mapM (f ms)
  (seqM (mapcar f ms)))

(defstruct maybe x)

(defmethod bind ((m maybe) f)
  (ematch (maybe-x m)
    (:nothing (make-maybe :x :nothing))
    ((cons :just x) (funcall f x))))

(defmethod fmap ((m maybe) f)
  (make-maybe :x (ematch (maybe-x m)
                   (:nothing :nothing)
                   ((cons :just x) (cons :just (funcall f x))))))

(defun baz (xs)
  (labels ((bar (x)
             (if (minusp x)
                 (make-maybe :x :nothing)
                 (make-maybe :x (cons :just (sqrt x))))))
    (mapM #'bar xs)))

(baz '(1 4 9))  ;=> #S(MAYBE :X (:JUST 1 2 3))
(baz '(1 -4 9)) ;=> #S(MAYBE :X :NOTHING)