Capture flow to portal

1 files changed, 84 insertions, 0 deletions

diff --git a/portal.clj b/portal.clj
new file mode 100644
index 0000000..ce05eb8
--- /dev/null
+++ b/portal.clj
@@ -0,0 +1,84 @@
+(ns portal
+  (:require [missionary.core :as m]
+            [clojure.set :refer [union difference]]))
+
+(def focused-tags (atom #{}))
+(def >focused-tags (m/signal (m/watch focused-tags)))
+
+(def seen-tags (atom #{}))
+(def >seen-tags (m/signal (m/watch seen-tags)))
+
+(defn rec
+  "Record flow f, tagging with id."
+  [id f]
+  (m/ap
+   (let [capturing? (atom nil)
+         [tag value]
+         (m/amb= [:focused-tags (m/?< >focused-tags)]
+                 [:event (m/?< f)])]
+     (case tag
+       :focused-tags
+       (do
+         (reset! capturing? (boolean (value id)))
+         (m/amb))
+
+       :event
+       (do
+         (swap! seen-tags conj id)
+         (when @capturing?
+           (m/? (m/via m/blk ((requiring-resolve 'portal.api/submit) [id value]))))
+         value)))))
+
+(defn ptags
+  "Print all available tags."
+  [] @seen-tags)
+
+(def show-portal? (atom false))
+(def >show-portal? (rec :show-portal? (m/signal (m/watch show-portal?))))
+
+(defn show-portal
+  "Show portal window."
+  []
+  (reset! show-portal? true))
+
+(defn hide-portal
+  "Hide portal window."
+  []
+  (reset! show-portal? false))
+
+(def >portal-ui
+  (m/ap
+   (when (m/?< >show-portal?)
+     (try
+       (m/?<
+        (m/observe
+         (fn [cb]
+           ((m/via m/blk ((requiring-resolve 'portal.api/open))) {} {})
+           (cb :open)
+           (fn []
+             ((m/via m/blk
+                     ((requiring-resolve 'portal.api/close))
+                     ((requiring-resolve 'portal.api/clear))) {} {})))))
+       (catch missionary.Cancelled _
+         (m/amb)))
+     (m/amb))))
+
+(defn cap
+  "Capture flow elements with specified ids to portal"
+  [& ids]
+  (reset! focused-tags (into #{} ids)))
+
+(defn +cap
+  "Add do portal capture set"
+  [& ids]
+  (swap! focused-tags union (into #{} ids)))
+
+(defn -cap
+  "Remove from portal capture set"
+  [& ids]
+  (swap! focused-tags difference (into #{} ids)))
+
+(def >portal-main
+  "Main entrypoint."
+  (m/ap (m/amb= (do (m/?< >portal-ui)
+                    (m/amb)))))