control flow macro v2

monad.clj

(ns miracle.monad
  (:require [clojure.pprint :refer [pprint]]))

;; make clj-kondo happy
(def | ::err)

(defn left
  [o]
  {::left o})

(defn right
  [o]
  {::right o})

(defn left?
  [o]
  (::left o))

(defn right?
  [o]
  (::right o))

(defn option?
  [o]
  (or (::right o)
      (::left o)))

(defn unwrap
  [o]
  (cond (option? o)
        (or (::left o) (::right o))))

(defn unwrap-or-f
  "Tries unwrapping, if value is `left`, run `f` on it."
  ([res]
   (unwrap-or-f res #(throw (ex-info "Tried unwrapping left value." (left %)))))
  ([res f]
   (if (option? res)
     (if (left? res)
       (f (unwrap res))
       (unwrap res))
     res)))

(defn handle-form
  [forms]
  (if (empty? forms)
    nil
    (let [[form & more] forms]
      (cond
        (nil? form) nil
        
        (= (first more) '|)
        `[~(let [res (gensym "res")
                 e (gensym "error")]
             `(try 
                (let [~res (do ~@(handle-form [form]))]
                  (unwrap-or-f ~res ~(second more)))
                (catch Error ~e
                  (~(second more) ~e))))
          ~@(handle-form (drop 2 more))]
        
        (and (seq? form)
             (= (first form) 'def))    
        `[(let [~(second form) (unwrap-or-f (do ~@(handle-form (drop 2 form))))]
            ~@(handle-form more))]
        
        more `[~form ~@(handle-form more)]
        
        :else `[~form #_(let [res# ~form]
                          (if (option? res#)
                            (unwrap res#)
                            res#))]))))

(defmacro =>
  [& forms]
  `(do ~@(handle-form forms)))

(pprint (macroexpand
         '(=> (def res (right "right"))
              (def res2 (left "left") | #(str "other branch " %))
              (str res " " res2))))

(=> (def res (right "right"))
    (def res2 (left "left") | #(str "other branch " %))
    (println res res2)
    (def res3 (left "unhandled left"))
    (println "wont get here"))

(=> (throw (Error. "hoho")) | #(str "other branch " %)
    (println "1")
    (throw (Error. "can't touch this"))
    (println "2 (won't get here)"))

(comment
  (pprint
   (macroexpand
    '(=> (def res (merge {:name "Jona", :cat "Charlie"})) ;; "define"
         (def wat
           (=> (def res (merge res {:friend "sogaiu"}))
               (println "inner print" res)
               (def cool-number (rand-int 2))
               (when (= 1 cool-number)
                 (throw (Error. "cool-number was 1")))
               (str "wat will be cool " cool-number))
           | (fn [err]
               (println "handling error" (-> (Throwable->map err) :via first :message))
               "wat should be something else"
               #_ (throw err) ;; you can re-throw it if you want
               ))
         (println "wat" wat)
         (def res (merge res {:wife "Cindy"}))
         (println "outer print" res))))
  
  (=> (def res (merge {:name "Jona", :cat "Charlie"})) ;; "define"
      (def wat
        (=> (def res (merge res {:friend "sogaiu"}))
            (println "inner print" res)
            (def cool-number (rand-int 2))
            (when (= 1 cool-number)
              (throw (Error. "cool-number was 1")))
            (str "wat will be cool " cool-number))
        | (fn [err]
            (println "handling error" (-> (Throwable->map err) :via first :message))
            "wat should be something else"
            #_ (throw err) ;; you can re-throw it if you want
            ))
      (println "wat" wat)
      (def res (merge res {:wife "Cindy"}))
      (println "outer print" res)))