dvingo · September 13, 2022 19:28
diff --git a/malli-schema->pathom.cljc b/malli-schema->pathom.cljc
 (ns my-app.malli.transform.pathom
  (:refer-clojure :exclude [uuid])
  (:require
    [malli.core :as m]
    [taoensso.timbre :as log]))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; helpers
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (def recur-types #{:map :vector})
 (defn recur-type? [value]
  (assert (contains? value :type) "You need to pass in a proper malli ast (with a :type key).")
  (contains? recur-types (:type value)))

 (defn ref-type? [{:keys [value]}]
  (log/trace "checking ref type :  " value)
  (def value' value)
  (when value
    (m/-ref-schema? (m/schema value))))

 (defn get-id-prop
  "Return property that has the tag ::db/identity? else the first property whose keyword name part is `id`"
  [identity-kw schema-keys-map]
  (let [id (ffirst (filter (fn [[_ v]] (some-> v :properties identity-kw)) schema-keys-map))]
    (if id id
           (first (filter (fn [k] (some-> k name (= "id"))) (keys schema-keys-map))))))

 (defn schema->id-prop*
  ([id-kw ?s]
   (condp = (:type ?s)
     :map
     (ffirst (filter
               (fn [[k {:keys [properties]}]]
                 (println "filtering: " k )
                 (println "props: " properties )
                 (if id-kw
                   (when (id-kw properties)
                     (do
                       (println "have id-kw: " id-kw)
                       (println "props: " properties)
                       k))
                   (some-> k name (= "id"))))
               (:keys ?s)))
     ;(reduce-kv (fn [acc k {:keys [order value]}]
     ;             (cond (recur-type? value)
     ;                   acc
     ;
     ;                   (ref-type? value)
     ;                   (let [child-ast (m/ast (m/deref (:value value)))]
     ;                     (if (recur-type? child-ast)
     ;                       acc k)
     ;                     )
     ;
     ;                   ))
     ;
     ;  [] (:keys ?s))

     :and
     (let [map-children (filter (comp #{:map} :type) (:children ?s))]
       (assert (= (count map-children) 1) "Must only be one :map child for :and.")
       (log/info "parsing and: " ?s)
       (log/info "parsing and: " map-children)
       (schema->id-prop* id-kw (first map-children)))
     ))
  )

 (defn schema->id-prop [id-kw ?schema]
  (schema->id-prop* id-kw (m/ast ?schema)))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; parsing multi-method
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defmulti parse-ast-to-pathom-output :type)
 (defmethod parse-ast-to-pathom-output :default [{:keys [value]}] value)
 (defmethod parse-ast-to-pathom-output :uuid [ast])
 (defmethod parse-ast-to-pathom-output :local-date [ast])
 (defmethod parse-ast-to-pathom-output :enum [ast])

 (defmethod parse-ast-to-pathom-output :vector [{:keys [child properties]}]
  (def child' child)
  (def properties' properties)
  (log/trace "child: " child)

  (let [{child-key :value} child
        child-ast       (m/ast (m/deref (m/schema child-key)))
        schema-keys-map (:keys child-ast)
        id              (util/get-id-prop ::db/identity schema-keys-map)]
    (log/trace "id: " id)
    [id]))

 (defmethod parse-ast-to-pathom-output :and
  [{:keys [children] :as ast}]
  (let [map-children (filter (comp #{:map} :type) children)]
    (assert (= (count map-children) 1) "Must only be one :map child for :and.")
    (log/info "parsing and: " ast)
    (log/info "parsing and: " map-children)
    (parse-ast-to-pathom-output (first map-children))))

 (defmethod parse-ast-to-pathom-output :map
  [{:keys [keys]}]
  (log/trace "keys: " keys)
  ;; for each key in the keys children call parse-ast-to-pathom-output
  (let [out (reduce-kv
              (fn [acc k {:keys [order value] :as v}]
                (assoc acc order
                           (do
                             (log/trace "value: " (:value value))
                             (try
                               (log/trace " deref: " (m/deref (:value value)))
                               (catch #?(:clj Exception :cljs :default) e))
                             ;(log/debug "type: " (:type value) " recur ype: " (util/recur-type? value))
                             ;(log/debug "ref type?: " (util/ref-type? value))
                             (cond
                               (util/recur-type? value) {k (parse-ast-to-pathom-output value)}
                               (util/ref-type? value) (do
                                                        ;(log/debug "recur with ref: " (m/ast (m/deref (:value value))))
                                                        (let [child-ast (m/ast (m/deref (:value value)))]
                                                          (if (util/recur-type? child-ast)
                                                            {k (parse-ast-to-pathom-output child-ast)}
                                                            k)))
                               :else k))))
              []
              keys)]
    out))

 (defn schema->pathom-output [?schema]
  (parse-ast-to-pathom-output
    (m/ast ?schema)))
	(ns my-app.malli.transform.pathom
	(:refer-clojure :exclude [uuid])
	(:require
	[malli.core :as m]
	[taoensso.timbre :as log]))

	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	;; helpers
	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

	(def recur-types #{:map :vector})
	(defn recur-type? [value]
	(assert (contains? value :type) "You need to pass in a proper malli ast (with a :type key).")
	(contains? recur-types (:type value)))

	(defn ref-type? [{:keys [value]}]
	(log/trace "checking ref type : " value)
	(def value' value)
	(when value
	(m/-ref-schema? (m/schema value))))

	(defn get-id-prop
	"Return property that has the tag ::db/identity? else the first property whose keyword name part is `id`"
	[identity-kw schema-keys-map]
	(let [id (ffirst (filter (fn [[_ v]] (some-> v :properties identity-kw)) schema-keys-map))]
	(if id id
	(first (filter (fn [k] (some-> k name (= "id"))) (keys schema-keys-map))))))

	(defn schema->id-prop*
	([id-kw ?s]
	(condp = (:type ?s)
	:map
	(ffirst (filter
	(fn [[k {:keys [properties]}]]
	(println "filtering: " k )
	(println "props: " properties )
	(if id-kw
	(when (id-kw properties)
	(do
	(println "have id-kw: " id-kw)
	(println "props: " properties)
	k))
	(some-> k name (= "id"))))
	(:keys ?s)))
	;(reduce-kv (fn [acc k {:keys [order value]}]
	; (cond (recur-type? value)
	; acc
	;
	; (ref-type? value)
	; (let [child-ast (m/ast (m/deref (:value value)))]
	; (if (recur-type? child-ast)
	; acc k)
	; )
	;
	; ))
	;
	; [] (:keys ?s))

	:and
	(let [map-children (filter (comp #{:map} :type) (:children ?s))]
	(assert (= (count map-children) 1) "Must only be one :map child for :and.")
	(log/info "parsing and: " ?s)
	(log/info "parsing and: " map-children)
	(schema->id-prop* id-kw (first map-children)))
	))
	)

	(defn schema->id-prop [id-kw ?schema]
	(schema->id-prop* id-kw (m/ast ?schema)))

	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	;; parsing multi-method
	;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

	(defmulti parse-ast-to-pathom-output :type)
	(defmethod parse-ast-to-pathom-output :default [{:keys [value]}] value)
	(defmethod parse-ast-to-pathom-output :uuid [ast])
	(defmethod parse-ast-to-pathom-output :local-date [ast])
	(defmethod parse-ast-to-pathom-output :enum [ast])

	(defmethod parse-ast-to-pathom-output :vector [{:keys [child properties]}]
	(def child' child)
	(def properties' properties)
	(log/trace "child: " child)

	(let [{child-key :value} child
	child-ast (m/ast (m/deref (m/schema child-key)))
	schema-keys-map (:keys child-ast)
	id (util/get-id-prop ::db/identity schema-keys-map)]
	(log/trace "id: " id)
	[id]))

	(defmethod parse-ast-to-pathom-output :and
	[{:keys [children] :as ast}]
	(let [map-children (filter (comp #{:map} :type) children)]
	(assert (= (count map-children) 1) "Must only be one :map child for :and.")
	(log/info "parsing and: " ast)
	(log/info "parsing and: " map-children)
	(parse-ast-to-pathom-output (first map-children))))

	(defmethod parse-ast-to-pathom-output :map
	[{:keys [keys]}]
	(log/trace "keys: " keys)
	;; for each key in the keys children call parse-ast-to-pathom-output
	(let [out (reduce-kv
	(fn [acc k {:keys [order value] :as v}]
	(assoc acc order
	(do
	(log/trace "value: " (:value value))
	(try
	(log/trace " deref: " (m/deref (:value value)))
	(catch #?(:clj Exception :cljs :default) e))
	;(log/debug "type: " (:type value) " recur ype: " (util/recur-type? value))
	;(log/debug "ref type?: " (util/ref-type? value))
	(cond
	(util/recur-type? value) {k (parse-ast-to-pathom-output value)}
	(util/ref-type? value) (do
	;(log/debug "recur with ref: " (m/ast (m/deref (:value value))))
	(let [child-ast (m/ast (m/deref (:value value)))]
	(if (util/recur-type? child-ast)
	{k (parse-ast-to-pathom-output child-ast)}
	k)))
	:else k))))
	[]
	keys)]
	out))

	(defn schema->pathom-output [?schema]
	(parse-ast-to-pathom-output
	(m/ast ?schema)))