comonad.scm

;;; data Comonad f a where
;;;   Comonad a ((Comonad f a -> b) -> f b)

; counit : Comonad f a -> a
; cobind : Comonad f a -> (Comonad f a -> b) -> Comonad f b

; lift : (f a -> a) -> (f a -> (f a -> b) -> f b) -> (f a -> Comonad f a)
; run  : Comonad f a -> f a

(define Comonad cons)

(define (counit m) (car m))
(define (cobind m f)
  (let ((v (car m)) (k (cdr m)))
    (Comonad (f m) (lambda (p) (k (lambda (n) (p (cobind n f))))))))

(define (lift u n)
  (define (unrun m)
    (Comonad (u m)
             (lambda (f)
               (n m (lambda (x) (f (unrun x)))))))
  unrun)
(define (run m)
  (let ((v (car m)) (k (cdr m)))
    (k (lambda (_) v))))

monad.scm

; data Monad f a where                         ; Monad as a data structure
;   Unit : a -> Monad f a
;   Bind : f a -> (a -> Monad f b) -> Monad f b

; unit : a -> Monad f a
; bind : Monad f a -> (a -> Monad f b) -> Monad f b

; lift : f a -> Monad f a
; run  : (a -> f a) -> (f b -> (b -> f a) -> f a) -> (Monad f a -> f a)

;;; Monad Constructors
(define (Unit x) (cons x #f))
(define (Bind m k) (cons m k))

;;; Monad Operators
(define (unit x) (Unit x))
(define (bind m f)
  (let ((v (car m)) (k (cdr m)))
    (if k
        (Bind v (lambda (x) (bind (k x) f)))
        (k v))))

;;; Interoperation
(define (lift x) (Bind x Unit))
(define (run u n)
  (define (unlift m)
    (let ((v (car m)) (k (cdr m)))
      (if k
          (n v (lambda (x) (unlift (k x))))
          (u v))))
  unlift)