Last active
January 16, 2024 13:31
-
-
Save ah45/7518292c620679c460557a7038751d6d to your computer and use it in GitHub Desktop.
Railway Oriented Programming in Clojure using (funcool) Cats
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(ns railway-oriented-programming | |
"An adaptation of [Railway Oriented Programming](rop) using the | |
[Cats](cats) library in Clojure. | |
[rop]: http://fsharpforfunandprofit.com/posts/recipe-part2/ | |
[cats]: https://github.com/funcool/cats" | |
(:require [cats.builtin] | |
[cats.core :as cats] | |
[cats.monad.either :as either])) | |
(def succeed | |
"Convert a value into a two-track (success) result" | |
either/right) | |
(def fail | |
"Convert a value into a two-track (failure) result" | |
either/left) | |
(def success? | |
"Returns true if the given two-track value is a success" | |
either/right?) | |
(def failure? | |
"Returns true if the given two-track value is a failure" | |
either/left?) | |
(defn either | |
"Returns a fn which takes a two-track value and applies success-fn or | |
failure-fn as appropriate." | |
[success-fn failure-fn] | |
#(either/branch % failure-fn success-fn)) | |
(defn switch | |
"Converts a normal fn into a switch (one-track input, two-track output)" | |
[f] | |
(comp succeed f)) | |
(defn bind | |
"Converts a switch fn into a two-track input/two-track output fn" | |
[f] | |
(either f fail)) | |
(defn =fn= | |
"Converts a normal fn into a two-track fn (aka 'map')" | |
[f] | |
(bind (switch f))) | |
(def >>= | |
"An infix version of bind for piping two-track values into switch fns. | |
Can be used to pipe two-track values through a series of switch fns: | |
(>>= (succeed 1) | |
(switch inc) | |
(switch #(* % 2)) | |
(switch #(+ % 3)) | |
(switch dec)) | |
;=> #<Right 6> | |
(Alias for `cats.core/>>=`.)" | |
cats/>>=) | |
(defn >> | |
"Composes functions into a single function, left-to-right | |
(the opposite of `comp`): | |
((>> #(* % 2) inc) 1) ;=> 3 | |
((comp #(* % 2) inc) 1) ;=> 4 | |
" | |
([] identity) | |
([f] f) | |
([f g] | |
(fn | |
([] (g (f))) | |
([x] (g (f x))) | |
([x y] (g (f x y))) | |
([x y z] (g (f x y z))) | |
([x y z & args] (g (apply f x y z args))))) | |
([f g & fs] | |
(reduce >> (into [f g] fs)))) | |
(defn >=> | |
"Composes two switch functions in series, left-to-right" | |
[f g] | |
(comp (bind g) f)) | |
(defn tee | |
"Returns a fn that calls f on its argument and returns its argument. | |
Converts otherwise 'dead-end' fns into one-track fns." | |
[f] | |
(fn [v] | |
(f v) | |
v)) | |
(defn try-catch | |
"Converts a one-track fn that may throw into a switch fn that captures any | |
exceptions as failures" | |
[f] | |
(fn [x] | |
(try | |
(succeed (f x)) | |
(catch Exception e | |
(fail e))))) | |
(defn double-map | |
"Builds a two-track fn from two one-track fns that handle success and failure | |
values respectively" | |
[success-fn failure-fn] | |
(cats/bimap failure-fn success-fn)) | |
(defn plus' | |
"Joins two switch fns in parallel, returning a switch fn that calls s1 and s2 | |
on its argument (in parallel) and merges the results via the provided merge-* | |
fns. | |
If s1 and s2 succeed then the result is the `merge-success` value of their | |
results. | |
If s1 and s2 fail then the result is the `merge-failure` value of | |
their results. | |
If only s1 or s2 fail then the result is the respective failure." | |
[merge-success merge-failure s1 s2] | |
(fn [x] | |
(let [[r1 r2 :as r] (pmap #(% x) [s1 s2]) | |
[v1 v2] (map cats/extract r)] | |
(cond | |
(every? success? r) (succeed (merge-success v1 v2)) | |
(every? failure? r) (fail (merge-failure v1 v2)) | |
(failure? r1) r1 | |
(failure? r2) r2)))) | |
(def plus (cats/curry plus')) | |
(def ^:dynamic *merge-success* | |
"Default success value merge fn used in `&&>`, returns its second argument." | |
(fn [_ x] x)) | |
(def ^:dynamic *merge-failure* | |
"Default failure value merge fn used in `&&>`, returns its second argument." | |
(fn [_ x] x)) | |
(defn &&> | |
"Questionable syntax sugar for `plus` using dynamically bound | |
merge fns (see `*merge-success*` and `*merge-failure*`.) | |
Allows this: | |
(def combined-validator | |
(let [&&& (plus (fn [x _] x) merge)] | |
(-> validate-keys | |
(&&& validate-name) | |
(&&& validate-name-length) | |
(&&& validate-email)))) | |
… to be written as: | |
(def combined-validator | |
(binding [*merge-failure* merge] | |
(&&> validate-keys | |
validate-name | |
validate-name-length | |
validate-email))) | |
" | |
[switch-fn & switch-fns] | |
(reduce (plus *merge-success* *merge-failure*) switch-fn switch-fns)) | |
;; example pulling it all together | |
(comment | |
(require '[clojure.string :as string] | |
'[clojure.pprint :refer [pprint]]) | |
;; prefer printing monads as refs rather than maps | |
(prefer-method | |
clojure.pprint/simple-dispatch | |
clojure.lang.IDeref | |
clojure.lang.IPersistentMap) | |
(defn validate-keys [input] | |
(let [missing (merge | |
{} | |
(when-not (contains? input :name) {:name "must be present"}) | |
(when-not (contains? input :email) {:email "must be present"}))] | |
(if (seq missing) | |
(fail missing) | |
(succeed input)))) | |
(defn validate-name [input] | |
(if (string/blank? (:name input)) | |
(fail {:name "must not be blank"}) | |
(succeed input))) | |
(defn validate-name-length [input] | |
(if (> (count (:name input)) 50) | |
(fail {:name "must not be longer than 50 chars"}) | |
(succeed input))) | |
(defn validate-email [input] | |
(if (string/blank? (:email input)) | |
(fail {:email "must not be blank"}) | |
(succeed input))) | |
(def combined-validation | |
"Using `plus` to curry our own `&&&` fn and thread through it" | |
(let [&&& (plus | |
;; validation successes are all equal, use first | |
(fn [x & _] x) | |
;; merge error maps, combining duplicate keys into vectors | |
(fn [x y] (merge-with #(conj (if (coll? %1) %1 [%1]) %2) x y)))] | |
(-> validate-keys | |
(&&& validate-name) | |
(&&& validate-name-length) | |
(&&& validate-email)))) | |
(def combined-validation | |
"Using the `&&>` thread syntax" | |
(binding [;; validation successes are all equal, | |
;; default success merge fn is fine | |
;; merge error maps, combining duplicate keys into vectors | |
*merge-failure* (fn [x y] (merge-with #(conj (if (coll? %1) %1 [%1]) %2) x y))] | |
(&&> validate-keys | |
validate-name | |
validate-name-length | |
validate-email))) | |
(defn canonicalize-email [input] | |
(update input :email #(-> % string/trim string/lower-case))) | |
(defn update-database [input] | |
(if (= (:name input) "Guybrush Threepwood") | |
(throw (Exception. (str "Duplicate index: name '" (:name input) "'"))) | |
(pprint (str "adding " (:name input) " to database")))) | |
(def log-input | |
(double-map | |
(fn [x] (pprint (str "DEBUG: so far so good" x)) x) | |
(fn [x] (pprint (str "ERROR:" x)) x))) | |
;; example of bringing validation together with a side effecting | |
;; database update and logging | |
;; | |
;; the database update won’t happen if the validation fails and | |
;; the logging will print either the validated value or errors | |
;; | |
;; we can either use Clojure arrow style piping to compose fns: | |
(def validate-and-insert-user | |
(-> #'combined-validation | |
(>=> (switch canonicalize-email)) | |
(>=> (try-catch (tee update-database))) | |
(->> (comp log-input)))) | |
;; or we can either use fsharp style fn composition: | |
(def validate-and-insert-user | |
(>> combined-validation | |
(=fn= canonicalize-email) | |
(bind (try-catch (tee update-database))) | |
log-input)) | |
(map validate-and-insert-user | |
[{:name nil} | |
{:name "Elaine Marley" :email "elaine@booty.isle"} | |
{:name "Guybrush Threepwood" :email "guyb@threep.com"}]) | |
) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment