Add remaining major Fulcro ns

FIXME: use-effect/lifecycle macros are not finished
FIXME: See warnings from shadow about cljs.analyzer

Beware: untested!!!

src/sci/configs/fulcro/algorithms/data_targeting.cljs

@@ -0,0 +1,7 @@
+(ns sci.configs.fulcro.algorithms.data-targeting
+  (:require [sci.core :as sci]))
+
+(def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.algorithms.data-targeting))
+(def ns-def (sci/copy-ns com.fulcrologic.fulcro.algorithms.data-targeting sci-ns {}))
+
+(def namespaces {'com.fulcrologic.fulcro.algorithms.data-targeting ns-def})

src/sci/configs/fulcro/algorithms/form_state.cljs

@@ -0,0 +1,7 @@
+(ns sci.configs.fulcro.algorithms.form-state
+  (:require [sci.core :as sci]))
+
+  (def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.algorithms.form-state))
+  (def ns-def (sci/copy-ns com.fulcrologic.fulcro.algorithms.form-state sci-ns {}))
+
+  (def namespaces {'com.fulcrologic.fulcro.algorithms.form-state ns-def})

src/sci/configs/fulcro/algorithms/lookup.cljs

@@ -0,0 +1,8 @@
+(ns sci.configs.fulcro.algorithms.lookup
+  (:require [sci.core :as sci]))
+
+
+(def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.algorithms.lookup))
+(def ns-def (sci/copy-ns com.fulcrologic.fulcro.algorithms.lookup sci-ns {}))
+
+(def namespaces {'com.fulcrologic.fulcro.algorithms.lookup ns-def})

src/sci/configs/fulcro/algorithms/merge.cljs

@@ -0,0 +1,9 @@
+(ns sci.configs.fulcro.algorithms.merge
+  (:require
+   [sci.core :as sci]
+   [com.fulcrologic.fulcro.algorithms.merge :as merge]))
+
+(def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.algorithms.merge))
+(def ns-def (sci/copy-ns com.fulcrologic.fulcro.algorithms.merge sci-ns {}))
+
+(def namespaces {'com.fulcrologic.fulcro.algorithms.merge ns-def})

src/sci/configs/fulcro/algorithms/normalize.cljs

@@ -0,0 +1,8 @@
+(ns sci.configs.fulcro.algorithms.normalize
+  (:require [sci.core :as sci]))
+
+
+(def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.algorithms.normalize))
+(def ns-def (sci/copy-ns com.fulcrologic.fulcro.algorithms.normalize sci-ns {}))
+
+(def namespaces {'com.fulcrologic.fulcro.algorithms.normalize ns-def})

src/sci/configs/fulcro/algorithms/react_interop.cljs

@@ -0,0 +1,7 @@
+(ns sci.configs.fulcro.algorithms.react-interop
+  (:require [sci.core :as sci]))
+
+(def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.algorithms.react-interop))
+(def ns-def (sci/copy-ns com.fulcrologic.fulcro.algorithms.react-interop sci-ns {}))
+
+(def namespaces {'com.fulcrologic.fulcro.algorithms.react-interop ns-def})

src/sci/configs/fulcro/algorithms/tempid.cljs

@@ -0,0 +1,7 @@
+(ns sci.configs.fulcro.algorithms.tempid
+  (:require [sci.core :as sci]))
+
+  (def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.algorithms.tempid))
+  (def ns-def (sci/copy-ns com.fulcrologic.fulcro.algorithms.tempid sci-ns {}))
+
+  (def namespaces {'com.fulcrologic.fulcro.algorithms.tempid ns-def})

src/sci/configs/fulcro/algorithms/tx_processing/synchronous_tx_processing.cljs

@@ -0,0 +1,18 @@
+(ns sci.configs.fulcro.algorithms.tx-processing.synchronous-tx-processing
+  (:require [sci.core :as sci]
+            [com.fulcrologic.fulcro.algorithms.tx-processing.synchronous-tx-processing :as stx]))
+
+  (defn ^:sci/macro in-transaction [_&form _&env app-sym & body]
+    `(let [id# (:com.fulcrologic.fulcro.application/id ~app-sym)]
+       (swap! stx/apps-in-tx update id# conj (stx/current-thread-id))
+       (try
+         ~@body
+         (finally
+           (swap! apps-in-tx update id# pop)))))
+
+  (def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.algorithms.tx-processing.synchronous-tx-processing))
+  (def ns-def (assoc (sci/copy-ns com.fulcrologic.fulcro.algorithms.tx-processing.synchronous-tx-processing sci-ns
+                                  {:exclude [in-transaction]})
+                     'in-transaction (sci/copy-var in-transaction sci-ns)))
+
+  (def namespaces {'com.fulcrologic.fulcro.algorithms.tx-processing.synchronous-tx-processing ns-def})

src/sci/configs/fulcro/data_fetch.cljs

@@ -0,0 +1,10 @@
+(ns sci.configs.fulcro.data-fetch
+  (:require
+   [sci.core :as sci]
+   [com.fulcrologic.fulcro.data-fetch]))
+
+
+(def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.data-fetch))
+(def ns-def (sci/copy-ns com.fulcrologic.fulcro.data-fetch sci-ns {:exclude ['render-to-str]}))
+
+(def namespaces {'com.fulcrologic.fulcro.data-fetch ns-def})

src/sci/configs/fulcro/fulcro.cljs

@@ -23,19 +23,52 @@
    
    Early alpha. Many namespaces aren't exposed yet, and there are certainly
    bugs in how macros were ported to SCI."
-  (:require
-   [sci.configs.fulcro.algorithms.denormalize :as fdn]
-   [sci.configs.fulcro.application :as app]
-   [sci.configs.fulcro.component :as comp]
-   [sci.configs.fulcro.dom :as dom]
-   [sci.configs.fulcro.raw.component :as rc]))
+  (:require [sci.configs.fulcro.algorithms.data-targeting :as dt]
+            [sci.configs.fulcro.algorithms.denormalize :as fdn]
+            [sci.configs.fulcro.algorithms.form-state :as fs]
+            [sci.configs.fulcro.algorithms.lookup :as ah]
+            [sci.configs.fulcro.algorithms.merge :as merge]
+            [sci.configs.fulcro.algorithms.normalize :as fnorm]
+            [sci.configs.fulcro.algorithms.react-interop :as interop]
+            [sci.configs.fulcro.algorithms.tempid :as tempid]
+            [sci.configs.fulcro.algorithms.tx-processing.synchronous-tx-processing :as stx]
+            [sci.configs.fulcro.application :as app]
+            [sci.configs.fulcro.component :as comp]
+            [sci.configs.fulcro.data-fetch :as df]
+            [sci.configs.fulcro.dom :as dom]
+            [sci.configs.fulcro.mutations :as m]
+            [sci.configs.fulcro.networking.http-remote :as http-remote]
+            [sci.configs.fulcro.raw.component :as rc]
+            [sci.configs.fulcro.react.hooks :as hooks]
+            [sci.configs.fulcro.routing.dynamic-routing :as dr]
+            [sci.configs.fulcro.ui-state-machines :as uism]
+            [sci.core :as sci]
+            [edn-query-language.core]))
+
+(def eql-sci-ns (sci/create-ns 'edn-query-language.core))
+(def eql-ns-def (sci/copy-ns edn-query-language.core eql-sci-ns {}))
 
 (def namespaces
   (merge
+   {'edn-query-language.core eql-ns-def}
+   ah/namespaces
    app/namespaces
    comp/namespaces
+   df/namespaces
    dom/namespaces
+   dr/namespaces
+   dt/namespaces
    fdn/namespaces
-   rc/namespaces))
+   fnorm/namespaces
+   fs/namespaces
+   http-remote/namespaces
+   interop/namespaces
+   merge/namespaces
+   m/namespaces
+   rc/namespaces
+   hooks/namespaces
+   stx/namespaces
+   tempid/namespaces
+   uism/namespaces))
 
 (def config {:namespaces namespaces})

src/sci/configs/fulcro/mutations.cljs

@@ -0,0 +1,69 @@
+(ns sci.configs.fulcro.mutations
+  (:require [cljs.analyzer :as ana]
+            [cljs.spec.alpha :as s]
+            [clojure.string :as str]
+            [sci.core :as sci]
+            [com.fulcrologic.fulcro.algorithms.lookup :as ah]))
+
+(defn ^:sci/macro declare-mutation [_&form _&env name target-symbol]
+  `(def ~name (m/->Mutation '~target-symbol)))
+
+(s/def ::handler (s/cat
+                  :handler-name symbol?
+                  :handler-args (fn [a] (and (vector? a) (= 1 (count a))))
+                  :handler-body (s/+ (constantly true))))
+
+(s/def ::mutation-args (s/cat
+                        :sym symbol?
+                        :doc (s/? string?)
+                        :arglist (fn [a] (and (vector? a) (= 1 (count a))))
+                        :sections (s/* (s/or :handler ::handler))))
+
+(defn ^:sci/macro defmutation [_&form macro-env args]
+  ;; Body of defmutation*
+  (let [conform!       (fn [element spec value]
+                         (when-not (s/valid? spec value)
+                           (throw (ana/error macro-env (str "Syntax error in " element ": " (s/explain-str spec value)))))
+                         (s/conform spec value))
+        {:keys [sym doc arglist sections]} (conform! "defmutation" ::mutation-args args)
+        fqsym          (if (namespace sym)
+                         sym
+                         (symbol (str (deref sci.core/ns)) #_(name (ns-name *ns*)) (name sym)))
+        handlers       (reduce (fn [acc [_ {:keys [handler-name handler-args handler-body]}]]
+                                 (let [action? (str/ends-with? (str handler-name) "action")]
+                                   (into acc
+                                         (if action?
+                                           [(keyword (name handler-name)) `(fn ~handler-name ~handler-args
+                                                                             (binding [com.fulcrologic.fulcro.raw.components/*after-render* true]
+                                                                               ~@handler-body)
+                                                                             nil)]
+                                           [(keyword (name handler-name)) `(fn ~handler-name ~handler-args ~@handler-body)]))))
+                               []
+                               sections)
+        ks             (into #{} (filter keyword?) handlers)
+        result-action? (contains? ks :result-action)
+        env-symbol     'fulcro-mutation-env-symbol
+        method-map     (if result-action?
+                         `{~(first handlers) ~@(rest handlers)}
+                         `{~(first handlers) ~@(rest handlers)
+                           :result-action    (fn [~'env]
+                                               (binding [com.fulcrologic.fulcro.raw.components/*after-render* true]
+                                                 (when-let [~'default-action (ah/app-algorithm (:app ~'env) :default-result-action!)]
+                                                   (~'default-action ~'env))))})
+        doc            (or doc "")
+        multimethod    `(defmethod com.fulcrologic.fulcro.mutations/mutate '~fqsym [~env-symbol]
+                          (let [~(first arglist) (-> ~env-symbol :ast :params)]
+                            ~method-map))]
+    (if (= fqsym sym)
+      multimethod
+      `(do
+         (def ~(with-meta sym {:doc doc}) (com.fulcrologic.fulcro.mutations/->Mutation '~fqsym))
+         ~multimethod))))
+
+(def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.mutations))
+(def ns-def (assoc (sci/copy-ns com.fulcrologic.fulcro.mutations sci-ns
+                                {:exclude [declare-mutation defmutation]})
+                   'declare-mutation (sci/copy-var declare-mutation sci-ns)
+                   'defmutation (sci/copy-var defmutation sci-ns)))
+
+(def namespaces {'com.fulcrologic.fulcro.mutations ns-def})

src/sci/configs/fulcro/networking/http_remote.cljs

@@ -0,0 +1,7 @@
+(ns sci.configs.fulcro.networking.http-remote
+  (:require [sci.core :as sci]))
+
+  (def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.networking.http-remote))
+  (def ns-def (sci/copy-ns com.fulcrologic.fulcro.networking.http-remote sci-ns {}))
+
+  (def namespaces {'com.fulcrologic.fulcro.networking.http-remote ns-def})

src/sci/configs/fulcro/react/hooks.cljs

@@ -0,0 +1,34 @@
+(ns sci.configs.fulcro.react.hooks
+  (:require [sci.core :as sci]
+            [com.fulcrologic.fulcro.react.hooks :as hooks])
+  #_(:import (cljs.tagged_literals JSValue))) ; not avail. in cljs
+
+(defn ^:sci/macro use-effect 
+  ([_&form _&env f] `(hooks/useEffect ~f))
+  ([_&form _&env f dependencies]
+   (if true #_(enc/compiling-cljs?)
+       (let [deps (cond
+                    (nil? dependencies) nil
+                    ; JH: Not sure how to translate this to a sci/macro...
+                    ;(instance? JSValue dependencies) dependencies
+                    ;:else (JSValue. dependencies)
+                    :else dependencies
+                    )]
+         `(hooks/useEffect ~f ~deps))
+       `(hooks/useEffect ~f ~dependencies))))
+
+(defn ^:sci/macro use-lifecycle 
+  ([&form &env setup] `(use-lifecycle &form &env ~setup nil)) ; FIXME Is this correct self-ref for a sci macro?
+  ([&form &env setup teardown]
+   (cond
+     (and setup teardown) `(use-effect &form &env (fn [] (~setup) ~teardown) []) ; FIXME self-ref
+     setup `(use-effect (fn [] (~setup) ~(when true #_(enc/compiling-cljs?) 'js/undefined)) [])  ; FIXME self-ref
+     teardown `(use-effect (fn [] ~teardown) []))))  ; FIXME self-ref
+
+(def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.react.hooks))
+(def ns-def (assoc (sci/copy-ns com.fulcrologic.fulcro.react.hooks sci-ns
+                                {:exclude [use-effect use-lifecycle]})
+                   'use-effect (sci/copy-var use-effect sci-ns) 
+                   'use-lifecycle (sci/copy-var use-lifecycle sci-ns)))
+
+(def namespaces {'com.fulcrologic.fulcro.react.hooks ns-def})

src/sci/configs/fulcro/routing/dynamic_routing.cljs

@@ -0,0 +1,89 @@
+(ns sci.configs.fulcro.routing.dynamic-routing
+  (:require [cljs.analyzer :as ana]
+            [com.fulcrologic.fulcro.raw.components :as rc]
+            [com.fulcrologic.fulcro.routing.dynamic-routing :as dr]
+            [com.fulcrologic.fulcro.ui-state-machines :as uism]
+            [sci.core :as sci]))
+
+(defn compile-error [env form message]
+  (throw (ana/error (merge env (some-> form meta)) message)))
+
+(defn ^:sci/macro defrouter [_&form env router-sym arglist options & body]
+  (let [router-ns (str (deref sci.core/ns) #_(ns-name *ns*))]
+    ;; copied body of defrouter*
+    (when-not (and (vector? arglist) (= 2 (count arglist)))
+      (compile-error env options "defrouter argument list must have an entry for this and props."))
+    (when-not (map? options)
+      (compile-error env options "defrouter requires a literal map of options."))
+    #_(when-not (s/valid? ::defrouter-options options) ; JH - disabled spec check
+      (compile-error env options (str "defrouter options are invalid: " (s/explain-str ::defrouter-options options))))
+     (let [{:keys [router-targets]} options
+           _                      (when (empty? router-targets)
+                                    (compile-error env options "defrouter requires a vector of :router-targets with at least one target"))
+           id                     (keyword router-ns (name router-sym))
+           getq                   (fn [s] `(or (rc/get-query ~s)
+                                               (throw (ex-info (str "Route target has no query! "
+                                                                    (rc/component-name ~s)) {}))))
+           query                  (into [::dr/id
+                                         [::uism/asm-id id]
+                                         ::dr/dynamic-router-targets
+                                         {::dr/current-route (getq (first router-targets))}]
+                                        (map-indexed
+                                         (fn [idx s]
+                                           (when (nil? s)
+                                             (compile-error env options "defrouter :target contains nil!"))
+                                           {(keyword (str "alt" idx)) (getq s)})
+                                         (rest router-targets)))
+           initial-state-map      (into {::dr/id            id
+                                         ::dr/current-route `(rc/get-initial-state ~(first router-targets) ~'params)}
+                                        (map-indexed
+                                         (fn [idx s] [(keyword (str "alt" idx)) `(rc/get-initial-state ~s {})])
+                                         (rest router-targets)))
+           ident-method           (apply list `(fn [] [::dr/id ~id]))
+           initial-state-lambda   (apply list `(fn [~'params] ~initial-state-map))
+           states-to-render-route (if (seq body)
+                                    #{:routed :deferred}
+                                    `(constantly true))
+           always-render-body?    (and (map? options) (:always-render-body? options))
+           render-cases           (if always-render-body?
+                                    (apply list `(let [~'class (dr/current-route-class ~'this)]
+                                                   (let [~(first arglist) ~'this
+                                                         ~(second arglist) {:pending-path-segment ~'pending-path-segment
+                                                                            :route-props          ~'current-route
+                                                                            :route-factory        (when ~'class (comp/factory ~'class))
+                                                                            :current-state        ~'current-state
+                                                                            :router-state         (get-in ~'props [[::uism/asm-id ~id] ::uism/local-storage])}]
+                                                     ~@body)))
+                                    (apply list `(let [~'class (dr/current-route-class ~'this)]
+                                                   (if (~states-to-render-route ~'current-state)
+                                                     (when ~'class
+                                                       (let [~'factory (comp/factory ~'class)]
+                                                         (~'factory (rc/computed ~'current-route (rc/get-computed ~'this)))))
+                                                     (let [~(first arglist) ~'this
+                                                           ~(second arglist) {:pending-path-segment ~'pending-path-segment
+                                                                              :route-props          ~'current-route
+                                                                              :route-factory        (when ~'class (comp/factory ~'class))
+                                                                              :current-state        ~'current-state}]
+                                                       ~@body)))))
+           options                (merge
+                                   `{:componentDidMount (fn [this#] (dr/validate-route-targets this#))}
+                                   options
+                                   `{:query                   ~query
+                                     :ident                   ~ident-method
+                                     :use-hooks?              false
+                                     :initial-state           ~initial-state-lambda
+                                     :preserve-dynamic-query? true})]
+       `(comp/defsc ~router-sym [~'this {::dr/keys [~'id ~'current-route] :as ~'props}]
+          ~options
+          (let [~'current-state (uism/get-active-state ~'this ~id)
+                ~'state-map (comp/component->state-map ~'this)
+                ~'sm-env (uism/state-machine-env ~'state-map nil ~id :fake {})
+                ~'pending-path-segment (when (uism/asm-active? ~'this ~id) (uism/retrieve ~'sm-env :pending-path-segment))]
+            ~render-cases)))))
+
+(def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.routing.dynamic-routing))
+(def ns-def (assoc (sci/copy-ns com.fulcrologic.fulcro.routing.dynamic-routing sci-ns
+                                {:exclude [defrouter]})
+                   'defrouter (sci/copy-var defrouter sci-ns) ))
+
+(def namespaces {'com.fulcrologic.fulcro.routing.dynamic-routing ns-def})

src/sci/configs/fulcro/ui_state_machines.cljs

@@ -0,0 +1,17 @@
+(ns sci.configs.fulcro.ui-state-machines
+  (:require [sci.core :as sci]
+            [com.fulcrologic.fulcro.ui-state-machines :as uism]))
+
+(defn ^:sci/macro defstatemachine [_&form _&env name body]
+  (let [nmspc       (str (deref sci.core/ns) #_(ns-name *ns*))
+        storage-sym (symbol nmspc (str name))]
+    `(do
+       (def ~name (assoc ~body ::uism/state-machine-id '~storage-sym))
+       (uism/register-state-machine! '~storage-sym ~body))))
+
+(def sci-ns (sci/create-ns 'com.fulcrologic.fulcro.ui-state-machines))
+(def ns-def (assoc (sci/copy-ns com.fulcrologic.fulcro.ui-state-machines sci-ns
+                                {:exclude [defstatemachine]})
+                   'defstatemachine (sci/copy-var defstatemachine sci-ns)))
+
+(def namespaces {'com.fulcrologic.fulcro.ui-state-machines ns-def})