[#1152] Add algo.monads to libtests and projects.md

2022-01-23 20:06:22 +01:00 · 2022-01-23 20:06:22 +01:00 · ee15ef1798
commit ee15ef1798
parent d08b0d88d8
5 changed files with 321 additions and 82 deletions
--- a/deps.edn
+++ b/deps.edn
@ -119,7 +119,8 @@
                         edn-query-language/eql {:mvn/version "2021.07.18"}
                         meta-merge/meta-merge {:mvn/version "1.0.0"}
                         com.exoscale/lingo {:mvn/version "1.0.0-alpha14"}
-                         io.github.swirrl/dogstatsd {:mvn/version "0.1.39"}}
+                         io.github.swirrl/dogstatsd {:mvn/version "0.1.39"}
+                         org.clojure/algo.monads {:mvn/version "0.1.6"}}
            :classpath-overrides {org.clojure/clojure nil
                                  org.clojure/spec.alpha nil}}
           :clj-nvd
--- a/doc/libraries.csv
+++ b/doc/libraries.csv
@ -58,6 +58,7 @@ org.clj-commons/clj-http-lite,https://github.com/clj-commons/clj-http-lite
 org.clj-commons/digest,https://github.com/clj-commons/clj-digest
 org.clojars.askonomm/ruuter,https://github.com/askonomm/ruuter
 org.clojars.lispyclouds/contajners,https://github.com/lispyclouds/contajners
+org.clojure/algo.monads,https://github.com/clojure/algo.monads
 org.clojure/core.match,https://github.com/clojure/core.match
 org.clojure/data.csv,https://github.com/clojure/data.csv
 org.clojure/data.generators,https://github.com/clojure/data.generators
--- a/doc/projects.md
+++ b/doc/projects.md
@ -2,86 +2,89 @@

 The following libraries and projects are known to work with babashka.

- [Libraries](#libraries)
-  - [tools.namespace](#toolsnamespace)
-  - [test-runner](#test-runner)
-  - [spec.alpha](#specalpha)
-  - [tools.bbuild](#toolsbbuild)
-  - [clj-http-lite](#clj-http-lite)
-  - [spartan.spec](#spartanspec)
-  - [missing.test.assertions](#missingtestassertions)
-  - [medley](#medley)
-  - [limit-break](#limit-break)
-  - [clojure-csv](#clojure-csv)
-  - [regal](#regal)
-  - [cprop](#cprop)
-  - [comb](#comb)
-  - [nubank/docopt](#nubankdocopt)
-  - [arrangement](#arrangement)
-  - [clojure.math.combinatorics](#clojuremathcombinatorics)
-  - [testdoc](#testdoc)
-  - [doric](#doric)
-  - [clojure.data.zip](#clojuredatazip)
-  - [clj-psql](#clj-psql)
-  - [camel-snake-kebab](#camel-snake-kebab)
-  - [aero](#aero)
-  - [clojure.data.generators](#clojuredatagenerators)
-  - [honeysql](#honeysql)
-  - [bond](#bond)
-  - [portal](#portal)
-  - [version-clj](#version-clj)
-  - [matchete](#matchete)
-  - [progrock](#progrock)
-  - [clj-commons/fs](#clj-commonsfs)
-  - [cljc.java-time](#cljcjava-time)
-  - [environ](#environ)
-  - [gaka](#gaka)
-  - [failjure](#failjure)
-  - [pretty](#pretty)
-  - [clojure-term-colors](#clojure-term-colors)
-  - [binf](#binf)
-  - [rewrite-edn](#rewrite-edn)
-  - [expound](#expound)
-  - [omniconf](#omniconf)
-  - [slingshot](#slingshot)
-  - [hasch](#hasch)
-  - [crispin](#crispin)
-  - [ffclj](#ffclj)
-  - [multigrep](#multigrep)
-  - [java-http-clj](#java-http-clj)
-  - [component](#component)
-  - [minimallist](#minimallist)
-  - [ruuter](#ruuter)
-  - [clj-commons.digest](#clj-commonsdigest)
-  - [contajners](#contajners)
-  - [dependency](#dependency)
-  - [specmonstah](#specmonstah)
-  - [markdown-clj](#markdown-clj)
- [Pods](#pods)
- [Projects](#projects-1)
-  - [babashka-test-action](#babashka-test-action)
-  - [deps.clj](#depsclj)
-  - [4bb](#4bb)
-  - [babashka lambda layer](#babashka-lambda-layer)
-  - [Release on push Github action](#release-on-push-github-action)
-  - [justone/bb-scripts](#justonebb-scripts)
-  - [nativity](#nativity)
-  - [cldwalker/bb-clis](#cldwalkerbb-clis)
-  - [krell template](#krell-template)
-  - [wee-httpd](#wee-httpd)
-  - [covid19-babashka](#covid19-babashka)
-  - [bb-spotify](#bb-spotify)
-  - [lambdaisland/open-source](#lambdaislandopen-source)
-  - [dharrigan/spotifyd-notification](#dharriganspotifyd-notification)
-  - [nextjournal/ssh-github-auth](#nextjournalssh-github-auth)
-  - [turtlequeue/setup-babashka](#turtlequeuesetup-babashka)
-  - [interdep](#interdep)
-  - [sha-words](#sha-words)
-  - [adam-james-v/scripts](#adam-james-vscripts)
-  - [oidc-client](#oidc-client)
-  - [jirazzz](#jirazzz)
-  - [Babashka + scittle guestbook](#babashka--scittle-guestbook)
-  - [bb htmx todo app](#bb-htmx-todo-app)
+- [Projects](#projects)
+  - [Libraries](#libraries)
+    - [tools.namespace](#toolsnamespace)
+    - [test-runner](#test-runner)
+    - [spec.alpha](#specalpha)
+    - [tools.bbuild](#toolsbbuild)
+    - [clj-http-lite](#clj-http-lite)
+    - [spartan.spec](#spartanspec)
+    - [missing.test.assertions](#missingtestassertions)
+    - [medley](#medley)
+    - [limit-break](#limit-break)
+    - [clojure-csv](#clojure-csv)
+    - [regal](#regal)
+    - [cprop](#cprop)
+    - [comb](#comb)
+    - [nubank/docopt](#nubankdocopt)
+    - [arrangement](#arrangement)
+    - [clojure.math.combinatorics](#clojuremathcombinatorics)
+    - [testdoc](#testdoc)
+    - [doric](#doric)
+    - [clojure.data.zip](#clojuredatazip)
+    - [clj-psql](#clj-psql)
+    - [camel-snake-kebab](#camel-snake-kebab)
+    - [aero](#aero)
+    - [clojure.data.generators](#clojuredatagenerators)
+    - [honeysql](#honeysql)
+    - [bond](#bond)
+    - [portal](#portal)
+    - [version-clj](#version-clj)
+    - [matchete](#matchete)
+    - [progrock](#progrock)
+    - [clj-commons/fs](#clj-commonsfs)
+    - [cljc.java-time](#cljcjava-time)
+    - [environ](#environ)
+    - [gaka](#gaka)
+    - [failjure](#failjure)
+    - [pretty](#pretty)
+    - [clojure-term-colors](#clojure-term-colors)
+    - [binf](#binf)
+    - [rewrite-edn](#rewrite-edn)
+    - [expound](#expound)
+    - [omniconf](#omniconf)
+    - [slingshot](#slingshot)
+    - [hasch](#hasch)
+    - [crispin](#crispin)
+    - [ffclj](#ffclj)
+    - [multigrep](#multigrep)
+    - [java-http-clj](#java-http-clj)
+    - [component](#component)
+    - [minimallist](#minimallist)
+    - [ruuter](#ruuter)
+    - [clj-commons.digest](#clj-commonsdigest)
+    - [contajners](#contajners)
+    - [dependency](#dependency)
+    - [specmonstah](#specmonstah)
+    - [markdown-clj](#markdown-clj)
+    - [algo.monads](#algomonads)
+  - [Pods](#pods)
+  - [Projects](#projects-1)
+    - [babashka-test-action](#babashka-test-action)
+    - [deps.clj](#depsclj)
+    - [4bb](#4bb)
+    - [babashka lambda layer](#babashka-lambda-layer)
+    - [Release on push Github action](#release-on-push-github-action)
+    - [justone/bb-scripts](#justonebb-scripts)
+    - [nativity](#nativity)
+    - [cldwalker/bb-clis](#cldwalkerbb-clis)
+    - [krell template](#krell-template)
+    - [wee-httpd](#wee-httpd)
+    - [covid19-babashka](#covid19-babashka)
+    - [bb-spotify](#bb-spotify)
+    - [lambdaisland/open-source](#lambdaislandopen-source)
+    - [dharrigan/spotifyd-notification](#dharriganspotifyd-notification)
+    - [nextjournal/ssh-github-auth](#nextjournalssh-github-auth)
+    - [turtlequeue/setup-babashka](#turtlequeuesetup-babashka)
+    - [interdep](#interdep)
+    - [sha-words](#sha-words)
+    - [adam-james-v/scripts](#adam-james-vscripts)
+    - [oidc-client](#oidc-client)
+    - [jirazzz](#jirazzz)
+    - [Babashka + scittle guestbook](#babashka--scittle-guestbook)
+    - [bb htmx todo app](#bb-htmx-todo-app)
+    - [bb aws lambda runtime](#bb-aws-lambda-runtime)

 Also keep an eye on the [news](news.md) page for new projects, gists and other
 developments around babashka.
@ -786,6 +789,10 @@ Write concise, maintainable test fixtures with clojure.spec.alpha.

 Markdown parser that translates markdown to html.

+### [algo.monads](https://github.com/clojure/algo.monads)
+
+Macros for defining monads, and definition of the most common monads.
+
 ## Pods

 [Babashka pods](https://github.com/babashka/babashka.pods) are programs that can
--- a/test-resources/lib_tests/bb-tested-libs.edn
+++ b/test-resources/lib_tests/bb-tested-libs.edn
@ -102,4 +102,5 @@
 edn-query-language/eql {:git-url "https://github.com/edn-query-language/eql", :test-namespaces (edn-query-language.core-test), :git-sha "0d4f9745d98c3d20b81bb4bdce3e8e15db7fd094"}
 meta-merge/meta-merge {:git-url "https://github.com/weavejester/meta-merge", :test-namespaces (meta-merge.core-test), :git-sha "c968c38baccd4219fe0ba592d89af37ea8e426bf"}
 com.exoscale/lingo {:git-url "https://github.com/exoscale/lingo", :test-namespaces (exoscale.lingo.test.core-test), :git-sha "30b5084fab28d24c99ec683e21535366910d9f2f" :skip-windows true}
- io.github.swirrl/dogstatsd {:git-url "https://github.com/swirrl/dogstatsd", :test-namespaces (swirrl.dogstatsd-test), :git-sha "e110caae452cd1185e65e389a359b69502076d61"}}
+ io.github.swirrl/dogstatsd {:git-url "https://github.com/swirrl/dogstatsd", :test-namespaces (swirrl.dogstatsd-test), :git-sha "e110caae452cd1185e65e389a359b69502076d61"}
+ org.clojure/algo.monads {:git-url "https://github.com/clojure/algo.monads", :test-namespaces (clojure.algo.test-monads), :git-sha "3a985b0b099110b1654d568fecf597bc9c8d1ff5"}}
--- a/test-resources/lib_tests/clojure/algo/test_monads.clj
+++ b/test-resources/lib_tests/clojure/algo/test_monads.clj
@ -0,0 +1,229 @@
+;; Test routines for clojure.algo.monads
+
+;; Copyright (c) Konrad Hinsen, 2011. All rights reserved.  The use
+;; and distribution terms for this software are covered by the Eclipse
+;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;; which can be found in the file epl-v10.html at the root of this
+;; distribution.  By using this software in any fashion, you are
+;; agreeing to be bound by the terms of this license.  You must not
+;; remove this notice, or any other, from this software.
+
+(ns clojure.algo.test-monads
+  (:use [clojure.test :only (deftest is are run-tests)]
+        [clojure.algo.monads
+         :only (with-monad domonad m-lift m-seq m-chain writer-m write
+                 sequence-m maybe-m state-m maybe-t sequence-t
+                 reader-m ask asks local)]))
+
+
+(deftest domonad-if-then
+  (let [monad-value (domonad maybe-m
+                      [ a 5
+                        :let [c 7]
+                        :if (and (= a 5) (= c 7))
+                        :then [
+                          b 6
+                        ]
+                        :else [
+                          b nil
+                        ]]
+                      [a b])]
+  (is (= monad-value [5 6]))))
+
+(deftest domonad-nested-if-then
+  (let [monad-value (domonad maybe-m
+                      [ a 5
+                       :if (= a 5)
+                        :then [
+                          b 6
+                          :if (= b 6)
+                          :then [
+                            c 7
+                          ]
+                          :else [
+                            c nil
+                          ]  
+                        ]
+                        :else [
+                          b nil
+                          c nil
+                        ]]
+                      [a b c])]
+  (is (= monad-value [5 6 7]))))
+
+(deftest domonad-if-then-with-when
+  (let [monad-value (domonad maybe-m
+                      [ a 5
+                        :when (= a 5)
+                        :if (= a 1)
+                        :then [
+                          b 6]
+                        :else [
+                          b nil]]
+                      [a b])]
+  (is (= monad-value nil))))
+
+(deftest domonad-cond
+  (let [monad-value (domonad maybe-m
+                      [ a 5
+                        :when (= a 5)
+                        :cond
+                          [(< a 1)
+                            [result "less than one"]
+                           (< a 3)
+                            [result "less than three"]
+                           (< a 6)
+                            [result "less than six"]
+                           :else
+                            [result "arbitrary number"]]
+                        b 7
+                        :let [some-val 12345]]
+                      [result b some-val])]
+  (is (= monad-value ["less than six" 7 12345]))))
+
+(deftest sequence-monad
+  (with-monad sequence-m
+    (are [a b] (= a b)
+      (domonad [x (range 3) y (range 2)] (+ x y))
+        '(0 1 1 2 2 3)
+      (domonad [x (range 5) y (range (+ 1 x)) :when  (= (+ x y) 2)] (list x y))
+        '((1 1) (2 0))
+      ((m-lift 2 #(list %1 %2)) (range 3) (range 2))
+        '((0 0) (0 1) (1 0) (1 1) (2 0) (2 1))
+      (m-seq (repeat 3 (range 2)))
+        '((0 0 0) (0 0 1) (0 1 0) (0 1 1) (1 0 0) (1 0 1) (1 1 0) (1 1 1))
+      ((m-chain (repeat 3 range)) 5)
+        '(0 0 0 1 0 0 1 0 1 2)
+      (m-plus (range 3) (range 2))
+        '(0 1 2 0 1))))
+
+(deftest maybe-monad
+  (with-monad maybe-m
+    (let [m+ (m-lift 2 +)
+          mdiv (fn [x y] (domonad [a x  b y  :when (not (zero? b))] (/ a b)))]
+      (are [a b] (= a b)
+        (m+ (m-result 1) (m-result 3))
+          (m-result 4)
+        (mdiv (m-result 1) (m-result 3))
+          (m-result (/ 1 3))
+        (m+ 1 (mdiv (m-result 1) (m-result 0)))
+          m-zero
+        (m-plus m-zero (m-result 1) m-zero (m-result 2))
+          (m-result 1)))))
+
+(deftest writer-monad
+  (is (= (domonad (writer-m "")
+                  [x (m-result 1)
+                   _ (write "first step\n")
+                   y (m-result 2)
+                   _ (write "second step\n")]
+                  (+ x y))
+         [3 "first step\nsecond step\n"]))
+  (is (= (domonad (writer-m [])
+                  [_ (write :a)
+                   a (m-result 1)
+                   _ (write :b)
+                   b (m-result 2)]
+                  (+ a b))
+         [3 [:a :b]]))
+  (is (= (domonad (writer-m ())
+                  [_ (write :a)
+                   a (m-result 1)
+                   _ (write :b)
+                   b (m-result 2)]
+                  (+ a b))
+         [3 '(:a :b)]))
+  (is (= (domonad (writer-m (list))
+                  [_ (write :a)
+                   a (m-result 1)
+                   _ (write :b)
+                   b (m-result 2)]
+                  (+ a b))
+         [3 (list :a :b)]))
+  (is (= (domonad (writer-m #{})
+                  [_ (write :a)
+                   a (m-result 1)
+                   _ (write :a)
+                   b (m-result 2)]
+                  (+ a b))
+         [3 #{:a}]))
+  (is (= (domonad (writer-m ())
+                  [_ (domonad
+                      [_ (write "foo")]
+                      nil)
+                   _ (write "bar")]
+                  1)
+         [1 '("foo" "bar")])))
+
+(deftest reader-monad
+  (let [monad-value (domonad reader-m
+                             [x (asks :number)]
+                             (* x 2))]
+    (is (= (monad-value {:number 3})
+           6)))
+
+  (let [monad-value (domonad reader-m
+                             [env (ask)]
+                             env)]
+    (is (= (monad-value "env")
+           "env")))
+
+  (let [monad-value (domonad reader-m
+                             [numbers (ask)
+                              sum  (m-result (reduce + numbers))
+                              mean (m-result (/ sum (count numbers)))]
+                             mean)]
+    (is (= (monad-value (range 1 10))
+           5)))
+
+  (let [monad-value (domonad reader-m
+                             [a (ask)
+                              b (local inc (ask))]
+                             (* a b))]
+    (is (= (monad-value 10)
+           110)))
+
+
+  (let [mult-a-b (fn []
+                   (domonad reader-m
+                            [a (asks :a)
+                             b (asks :b)]
+                            (* a b)))
+        monad-value (domonad reader-m
+                             [a  (asks :a)
+                              b  (asks :b)
+                              a* (local #(update-in % [:a] inc) (asks :a))
+                              c  (local #(assoc % :b 5)  (mult-a-b))]
+                             [a b a* c])]
+    (= (monad-value {:a 10})
+       [10 nil 11 50])))
+
+(deftest seq-maybe-monad
+  (with-monad (maybe-t sequence-m)
+    (letfn [(pairs [xs] ((m-lift 2 #(list %1 %2)) xs xs))]
+      (are [a b] (= a b)
+        ((m-lift 1 inc) (for [n (range 10)] (when (odd? n) n)))
+          '(nil 2 nil 4 nil 6 nil 8 nil 10)
+        (pairs (for [n (range 5)] (when (odd? n) n)))
+          '(nil nil (1 1) nil (1 3) nil nil nil (3 1) nil (3 3) nil nil)))))
+
+(deftest state-maybe-monad
+  (with-monad (maybe-t state-m)
+    (is (= (for [[a b c d] (list [1 2 3 4] [nil 2 3 4] [ 1 nil 3 4]
+                                 [nil nil 3 4] [1 2 nil nil])]
+             (let [f (domonad
+                       [x (m-plus (m-result a) (m-result b))
+                        y (m-plus (m-result c) (m-result d))]
+                       (+ x y))]
+               (f :state)))
+           (list [4 :state] [5 :state] [4 :state] [nil :state] [nil :state])))))
+
+(deftest state-seq-monad
+  (with-monad (sequence-t state-m)
+    (is (= (let [[a b c d] [1 2 10 20]
+                 f (domonad
+                     [x (m-plus (m-result a) (m-result b))
+                      y (m-plus (m-result c) (m-result d))]
+                     (+ x y))]
+             (f :state)))
+        (list [(list 11 21 12 22) :state]))))