From a4a7edd487d4d2207829462d06c40578dc757337 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Thu, 14 Mar 2019 20:08:58 +0100
Subject: Generilified return, monads now truly functors.

---
 control/monad.scm | 46 +++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 43 insertions(+), 3 deletions(-)

(limited to 'control/monad.scm')

diff --git a/control/monad.scm b/control/monad.scm
index 2ef230c..e964b48 100644
--- a/control/monad.scm
+++ b/control/monad.scm
@@ -1,8 +1,12 @@
 (define-module (control monad)
   #:use-module (control monad procedures)
+  #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
-  #:export (do)
-  #:re-export (>> >>=))
+  #:use-module (ice-9 curried-definitions)
+  #:replace (do)
+  #:export (sequence mapM
+                     fmap <$> cmap <*>)
+  #:re-export (>> >>= return))
 
 (define-syntax do
   (syntax-rules (<- let =)
@@ -11,7 +15,43 @@
        (ptrn (do rest ...))))
     ((_ ptrn <- val rest ...)
      (>>= val (match-lambda (ptrn (do rest ...)))))
-    ((_ a) a)
+    ((_ a) a) ; Base case
     ((_ token rest ...)
      (>> token (do rest ...)))))
 
+;;; ----------------------------------------
+
+(define (fmap f m)
+  (>>= m (lambda (x) ((return m) (f x)))))
+
+(define <$> fmap)
+
+;; Curried map
+(define (cmap f)
+  (lambda (m) (fmap f m)))
+
+(define (<*> f_ i_)
+  (do f <- f_
+      i <- i_
+      ((return f_) (f i))))
+
+;;; ----------------------------------------
+
+;; sequence :: (list (M a)) → M (list a)
+(define (sequence in-list)
+  "Evaluate each monadic action in the structure from left to right, and collect
+the results. For a version that ignores the results see sequence_.
+https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Monad.html#g:4"
+  (define ((f done) item) (append done (list item)))
+  (fold (lambda (m-item m-done)
+          #!curly-infix {{ f <$> m-done } <*> m-item })
+        ((return (car in-list)) '())
+        in-list))
+
+;; mapM :: (a -> M b) x (list a) → M (list b)
+(define (mapM proc items)
+  "Map each element of a structure to a monadic action, evaluate these actions from
+left to right, and collect the results. For a version that ignores the results
+see mapM_.
+https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Monad.html#g:4"
+  (sequence (map proc items)))
-- 
cgit v1.2.3