remove dependency from cats to play nice with protocols (#36)

* import cats to abide by the peace treaty

* tests passing

* remove bloat

* lint

* changelog/bump

* remove warning

* ok linter

* remove context

* remove context from impls

Author: sovelten

CHANGELOG.md

@@ -1,5 +1,8 @@
 # Changelog
 
+## 1.19.0 / 2024-08-15
+- Remove applicative engine dependency from funcool/cats
+
 ## 1.18.1 / 2024-07-16
 - Fix virtual-future applicative engine error handling so that ExecutionExceptions are always unwrapped
 - Improve ergonomics when an unknown engine is specified

project.clj

@@ -1,4 +1,4 @@
-(defproject dev.nu/nodely "1.18.1"
+(defproject dev.nu/nodely "1.19.0"
   :description "Decoupling data fetching from data dependency declaration"
   :url "https://github.com/nubank/nodely"
   :license {:name "MIT"}
@@ -9,7 +9,6 @@
   :dependencies [[org.clojure/clojure "1.10.3"]
                  [aysylu/loom "1.0.2"]
                  [org.clojure/core.async "1.5.648"]
-                 [funcool/cats "2.4.2"]
                  [funcool/promesa "10.0.594"]
                  [manifold "0.1.9-alpha5"]
                  [prismatic/schema "1.1.12"]]

src/nodely/engine/applicative.clj

@@ -1,54 +1,47 @@
 (ns nodely.engine.applicative
   (:refer-clojure :exclude [eval sequence])
   (:require
-   [cats.context :as context]
-   [cats.core :as m]
    [clojure.core.async :as async]
    [clojure.pprint :as pp]
    [nodely.data :as data]
+   [nodely.engine.applicative.core :as app]
    [nodely.engine.applicative.promesa :as promesa]
    [nodely.engine.applicative.protocols :as protocols]
    [nodely.engine.core :as core]
    [nodely.engine.lazy-env :as lazy-env]))
 
 (prefer-method pp/simple-dispatch clojure.lang.IPersistentMap clojure.lang.IDeref)
 
-;; sequenceA (x:xs) = (:) <$> x <*> sequenceA xs
-(defn sequence
-  [chs]
-  (reduce (m/lift-a 2 conj) (m/pure []) chs))
-
 (defn in-context?
   [x context]
-  (and (satisfies? cats.protocols/Contextual x)
-       (= context (cats.protocols/-get-context x))))
+  (= context (protocols/-get-context x)))
 
 (declare eval-node)
 
 (defn eval-sequence
-  [node lazy-env opts]
+  [node lazy-env {::keys [context] :as opts}]
   (let [in-key (::data/input node)
-        mf     (m/fmap ::data/value
-                       (eval-node (::data/process-node node) lazy-env opts))
+        mf     (app/fmap ::data/value
+                         (eval-node (::data/process-node node) lazy-env opts))
         mseq   (get lazy-env in-key)]
     (->> mseq
-         (m/fmap (comp m/sequence
-                       (partial map
-                                (comp (partial m/fapply mf)
-                                      m/pure))
-                       ::data/value))
-         m/join
-         (m/fmap data/value))))
+         (app/fmap (comp (partial app/sequence context)
+                         (partial map
+                                  (comp (partial app/fapply mf)
+                                        (partial app/pure context)))
+                         ::data/value))
+         app/join
+         (app/fmap data/value))))
 
 (defn eval-branch
   [{::data/keys [condition truthy falsey]}
    lazy-env
    opts]
-  (m/alet [condition-value-node (eval-node condition lazy-env opts)
-           result (if (::data/value condition-value-node)
-                    (eval-node truthy lazy-env opts)
-                    (eval-node falsey lazy-env opts))]
-          result))
+  (app/bind (eval-node condition lazy-env opts)
+            (fn [condition-value-node]
+              (if (:nodely.data/value condition-value-node)
+                (eval-node truthy lazy-env opts)
+                (eval-node falsey lazy-env opts)))))
 
 (defn noop-validate
   [return _]
@@ -60,60 +53,59 @@
         tags      (::data/tags leaf)
         f         (with-meta (::data/fn leaf)
                     {::data/tags tags})]
-    (m/mlet [v (protocols/apply-fn f (m/fmap #(core/prepare-inputs deps-keys (zipmap deps-keys %))
-                                             (sequence (mapv #(get lazy-env %) deps-keys))))]
-            (if (in-context? v context)
-              (m/fmap data/value v)
-              (m/pure context (data/value v))))))
+    (app/mlet [v (app/apply-fn f (app/fmap #(core/prepare-inputs deps-keys (zipmap deps-keys %))
+                                           (app/sequence context (mapv #(get lazy-env %) deps-keys))))]
+              (if (in-context? v context)
+                (app/fmap data/value v)
+                (app/pure context (data/value v))))))
 
 (defn eval-node
   [node lazy-env opts]
   (case (::data/type node)
-    :value    (m/pure node)
+    :value    (app/pure (::context opts) node)
     :leaf     (eval-leaf node lazy-env opts)
     :branch   (eval-branch node lazy-env opts)
     :sequence (eval-sequence node lazy-env opts)))
 
 (defn eval-in-context
   [env k lazy-env {::keys [fvalidate] :as opts}]
-  (context/with-context (::context opts)
-    (let [node     (get env k)
-          node-ret (eval-node node lazy-env opts)
-          validator (or fvalidate noop-validate)]
-      (validator node-ret node))))
+  (let [node     (get env k)
+        node-ret (eval-node node lazy-env opts)
+        validator (or fvalidate noop-validate)]
+    (validator node-ret node)))
 
 (defn eval-key
   ([env k]
    (eval-key env k {}))
   ([env k opts]
    (let [opts (merge {::context promesa/context} opts)
          lazy-env (lazy-env/lazy-env env eval-in-context opts)]
-     (::data/value (m/extract (get lazy-env k))))))
+     (::data/value (protocols/-extract (get lazy-env k))))))
 
 (defn eval-key-contextual
   ([env k]
    (eval-key env k {}))
   ([env k opts]
    (let [opts (merge {::context promesa/context} opts)
          lazy-env (lazy-env/lazy-env env eval-in-context opts)]
-     (m/fmap ::data/value (get lazy-env k)))))
+     (app/fmap ::data/value (get lazy-env k)))))
 
 (defn eval-key-channel
   ([env k]
    (eval-key-channel env k {}))
   ([env k opts]
    (let [contextual-v (eval-key-contextual env k opts)
          chan         (async/promise-chan)]
-     (m/fmap (partial async/put! chan) contextual-v)
+     (app/fmap (partial async/put! chan) contextual-v)
      chan)))
 
 (defn eval
   ([env k]
    (eval env k {::context promesa/context}))
   ([env k opts]
    (let [lazy-env (lazy-env/lazy-env env eval-in-context opts)]
-     (m/extract (get lazy-env k)) ;; ensures k is resolved
+     (protocols/-extract (get lazy-env k)) ;; ensures k is resolved
      (merge env
-            (reduce (fn [acc [k v]] (assoc acc k (m/extract v)))
+            (reduce (fn [acc [k v]] (assoc acc k (protocols/-extract v)))
                     {}
                     (lazy-env/scheduled-nodes lazy-env))))))

src/nodely/engine/applicative/core.clj

@@ -0,0 +1,172 @@
+(ns nodely.engine.applicative.core
+  (:refer-clojure :exclude [sequence])
+  (:require
+   [nodely.engine.applicative.protocols :as p]))
+
+(defn throw-illegal-argument
+  {:no-doc true :internal true}
+  [^String text]
+  (throw (IllegalArgumentException. text)))
+
+;; CONTEXT STUFF HERE
+
+(defprotocol Contextual
+  "Abstraction that establishes a concrete type as a member of a context.
+
+  A great example is the Maybe monad type Just. It implements
+  this abstraction to establish that Just is part of
+  the Maybe monad."
+  (-get-context [_] "Get the context associated with the type."))
+
+(extend-protocol p/Contextual
+  java.lang.Object
+  (-get-context [_] nil))
+
+(defn infer
+  "Given an optional value infer its context. If context is already set, it
+  is returned as is without any inference operation."
+  {:no-doc true}
+  [v]
+  (if-let [context (p/-get-context v)]
+    context
+    (throw-illegal-argument
+     (str "No context is set and it can not be automatically "
+          "resolved from provided value"))))
+
+;; END CONTEXT STUFF
+
+;; FUNCTOR STUFF
+(defn fmap
+  "Apply a function `f` to the value wrapped in functor `fv`,
+  preserving the context type."
+  [f fv]
+  (let [ctx (infer fv)]
+    (p/-fmap ctx f fv)))
+
+;; MONAD STUFF
+(defn bind
+  "Given a monadic value `mv` and a function `f`,
+  apply `f` to the unwrapped value of `mv`.
+
+      (bind (either/right 1) (fn [v]
+                               (return (inc v))))
+      ;; => #<Right [2]>
+
+  For convenience, you may prefer to use the `mlet` macro,
+  which provides a beautiful, `let`-like syntax for
+  composing operations with the `bind` function."
+  [mv f]
+  (let [ctx (infer mv)]
+    (p/-mbind ctx mv f)))
+
+(defn return
+  "This is a monad version of `pure` and works
+  identically to it."
+  [ctx v]
+  (p/-mreturn ctx v))
+
+(defn join
+  "Remove one level of monadic structure.
+  This is the same as `(bind mv identity)`."
+  [mv]
+  (bind mv identity))
+
+(defmacro mlet
+  "Monad composition macro that works like Clojure's
+     `let`. This facilitates much easier composition of
+     monadic computations.
+
+     Let's see an example to understand how it works.
+     This code uses bind to compose a few operations:
+
+         (bind (just 1)
+               (fn [a]
+                 (bind (just (inc a))
+                         (fn [b]
+                           (return (* b 2))))))
+         ;=> #<Just [4]>
+
+     Now see how this code can be made clearer
+     by using the mlet macro:
+
+         (mlet [a (just 1)
+                b (just (inc a))]
+           (return (* b 2)))
+         ;=> #<Just [4]>
+     "
+  [bindings & body]
+  (when-not (and (vector? bindings)
+                 (not-empty bindings)
+                 (even? (count bindings)))
+    (throw (IllegalArgumentException. "bindings has to be a vector with even number of elements.")))
+  (->> (reverse (partition 2 bindings))
+       (reduce (fn [acc [l r]] `(bind ~r (fn [~l] ~acc)))
+               `(do ~@body))))
+
+;; APPLICATIVE STUFF
+(defn pure
+  "Given any value `v`, return it wrapped in
+  the default/effect-free context.
+
+  This is a multi-arity function that with arity `pure/1`
+  uses the dynamic scope to resolve the current
+  context. With `pure/2`, you can force a specific context
+  value.
+
+  Example:
+
+      (with-context either/context
+        (pure 1))
+      ;; => #<Right [1]>
+
+      (pure either/context 1)
+      ;; => #<Right [1]>
+  "
+  [ctx v]
+  (p/-pure ctx v))
+
+(defn fapply
+  "Given a function wrapped in a monadic context `af`,
+  and a value wrapped in a monadic context `av`,
+  apply the unwrapped function to the unwrapped value
+  and return the result, wrapped in the same context as `av`.
+
+  This function is variadic, so it can be used like
+  a Haskell-style left-associative fapply."
+  [af & avs]
+  {:pre [(seq avs)]}
+  (let [ctx (infer af)]
+    (reduce (partial p/-fapply ctx) af avs)))
+
+(defn sequence
+  "Given a collection of monadic values, collect
+  their values in a seq returned in the monadic context.
+
+      (require '[cats.context :as ctx]
+               '[cats.monad.maybe :as maybe]
+               '[cats.core :as m])
+
+      (m/sequence [(maybe/just 2) (maybe/just 3)])
+      ;; => #<Just [[2, 3]]>
+
+      (m/sequence [(maybe/nothing) (maybe/just 3)])
+      ;; => #<Nothing>
+
+      (ctx/with-context maybe/context
+        (m/sequence []))
+      ;; => #<Just [()]>
+  "
+  [context mvs]
+  (if (empty? mvs)
+    (return context ())
+    (reduce (fn [mvs mv]
+              (mlet [v mv
+                     vs mvs]
+                    (return context (cons v vs))))
+            (return context ())
+            (reverse mvs))))
+
+(defn apply-fn
+  [f mv]
+  (let [ctx (infer mv)]
+    (p/-apply-fn ctx f mv)))