Skip to content

Instantly share code, notes, and snippets.

@ah45
Last active January 16, 2024 13:31
Show Gist options
  • Star 5 You must be signed in to star a gist
  • Fork 2 You must be signed in to fork a gist
  • Save ah45/7518292c620679c460557a7038751d6d to your computer and use it in GitHub Desktop.
Save ah45/7518292c620679c460557a7038751d6d to your computer and use it in GitHub Desktop.
Railway Oriented Programming in Clojure using (funcool) Cats
(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