arrows.lisp

;;;; Haskell's arrow library implemented in common lisp as an exercise
;;; date: 2019-09-17
;;; author: Niko L.

(defstruct arrow func)

(defmacro arr (args &body body)
  `(make-arrow :func (lambda ,args ,@body)))

(defun run (arrow arg)
  (funcall (arrow-func arrow) arg))

(defparameter *example-arrow* (make-arrow :func #'string))

(defun split ()
  "Creates a splitting arrow"
  (arr (x) (list x x)))

(defun unsplit (func)
  "Creates an unsplitting arrow which applies a binary function"
  (arr (x y) (funcall func x y)))

(defun >>> (&rest arrows)
  "generalised version of (>>>) :: a b c -> a c d -> a b d
   that lets the user run multiple >>> in a single statement"
  (arr (x) (reduce #'run arrows :initial-value x :from-end t)))

(defun fst (arrow)
  "a b c -> a (b, d) (c, d)"
  (arr (b d) (list (run arrow b) d)))

(defun snd (arrow)
  "a b c -> a (d, b) (d, c)"
  (arr (d b) (list d (run arrow b))))

(defun *** (arrow-a arrow-b)
  (>>> (fst arrow-a) (snd arrow-b)))

(defun &&& (arrow-a arrow-b)
  (>>> (split) (fst arrow-a) (snd arrow-b)))

(defun lift-a2 (binop arrow-a arrow-b)
  (>>> (split)(fst arrow-a) (snd arrow-b) (unsplit binop)))