Test out frontend optimized coercion impl for Malli

This commit is contained in:
Juho Teperi 2025-01-31 15:44:40 +02:00
parent 34b6bb9349
commit be92cceb83
11 changed files with 1640 additions and 96 deletions

3
.gitignore vendored
View file

@ -9,9 +9,10 @@ pom.xml.asc
.nrepl-port
/.nrepl-history
/gh-pages
/node_modules
node_modules
/_book
figwheel_server.log
/.idea
.clj-kondo
.shadow-cljs

1452
examples/frontend-malli/package-lock.json generated Normal file

File diff suppressed because it is too large Load diff

View file

@ -0,0 +1,18 @@
{
"name": "frontend-malli",
"version": "1.0.0",
"description": "## Usage",
"main": "index.js",
"scripts": {
"test": "echo \"Error: no test specified\" && exit 1"
},
"author": "",
"license": "ISC",
"dependencies": {
"react": "18.3.1",
"react-dom": "18.3.1"
},
"devDependencies": {
"shadow-cljs": "^2.28.20"
}
}

View file

@ -1,57 +0,0 @@
(defproject frontend-malli "0.1.0-SNAPSHOT"
:description "FIXME: write description"
:url "http://example.com/FIXME"
:license {:name "Eclipse Public License"
:url "http://www.eclipse.org/legal/epl-v10.html"}
:dependencies [[org.clojure/clojure "1.10.1"]
[ring-server "0.5.0"]
[reagent "1.2.0"]
[ring "1.12.1"]
[hiccup "1.0.5"]
[org.clojure/clojurescript "1.11.132"]
[metosin/reitit "0.8.0-alpha1"]
[metosin/reitit-malli "0.8.0-alpha1"]
[metosin/reitit-frontend "0.8.0-alpha1"]
[cljsjs/react "17.0.2-0"]
[cljsjs/react-dom "17.0.2-0"]
;; Just for pretty printting the match
[fipp "0.6.23"]]
:plugins [[lein-cljsbuild "1.1.8"]
[lein-figwheel "0.5.20"]]
:source-paths []
:resource-paths ["resources" "target/cljsbuild"]
:profiles {:dev {:dependencies [[binaryage/devtools "1.0.2"]]}}
:cljsbuild
{:builds
[{:id "app"
:figwheel true
:source-paths ["src"]
:watch-paths ["src" "checkouts/reitit-frontend/src"]
:compiler {:main "frontend.core"
:asset-path "/js/out"
:output-to "target/cljsbuild/public/js/app.js"
:output-dir "target/cljsbuild/public/js/out"
:source-map true
:optimizations :none
:pretty-print true
:preloads [devtools.preload]
:aot-cache true}}
{:id "min"
:source-paths ["src"]
:compiler {:output-to "target/cljsbuild/public/js/app.js"
:output-dir "target/cljsbuild/public/js"
:source-map "target/cljsbuild/public/js/app.js.map"
:optimizations :advanced
:pretty-print false
:aot-cache true}}]}
:figwheel {:http-server-root "public"
:server-port 3449
:nrepl-port 7002
;; Server index.html for all routes for HTML5 routing
:ring-handler backend.server/handler})

View file

@ -5,6 +5,6 @@
</head>
<body>
<div id="app"></div>
<script src="/js/app.js"></script>
<script src="/js/main.js"></script>
</body>
</html>

View file

@ -0,0 +1,13 @@
{:builds
{:app {:asset-path "/js"
:modules {:main {:entries [frontend.core]}}
:output-dir "target/public/js"
:target :browser}}
:dependencies [[reagent "1.2.0"]
[metosin/reitit "0.8.0-alpha1"]
[metosin/reitit-malli "0.8.0-alpha1"]
[metosin/reitit-frontend "0.8.0-alpha1"]
[fipp "0.6.23"]]
:dev-http {3000 ["resources/public" "target/public"]}
:nrepl {:port 3333}
:source-paths ["src"]}

View file

@ -1,10 +0,0 @@
(ns backend.server
(:require [ring.util.response :as resp]
[ring.middleware.content-type :as content-type]))
(def handler
(-> (fn [request]
(or (resp/resource-response (:uri request) {:root "public"})
(-> (resp/resource-response "index.html" {:root "public"})
(resp/content-type "text/html"))))
content-type/wrap-content-type))

View file

@ -3,7 +3,7 @@
[reagent.dom :as rd]
[reitit.frontend :as rf]
[reitit.frontend.easy :as rfe]
[reitit.coercion.malli :as rsm]
[reitit.coercion.frontend.malli :as rsm]
[fipp.edn :as fedn]))
(defn home-page []

View file

@ -0,0 +1,130 @@
(ns reitit.coercion.frontend.malli
"Optimized coercion implementation use with
Reitit-frontend.
Only supports string coercion, OpenAPI and Swagger support
removed."
(:require [clojure.walk :as walk]
[malli.core :as m]
[malli.experimental.lite :as l]
[malli.transform :as mt]
[malli.util :as mu]
[reitit.coercion :as coercion]
[reitit.coercion.malli.protocols :as p]))
(defn- -provider [transformer]
(reify p/TransformationProvider
(-transformer [_ {:keys [strip-extra-keys default-values]}]
(mt/transformer
(if strip-extra-keys (mt/strip-extra-keys-transformer))
transformer
(if default-values (mt/default-value-transformer))))))
(def string-transformer-provider (-provider (mt/string-transformer)))
(def default-transformer-provider (-provider nil))
(defn- -coercer [schema type transformers {:keys [validate enabled options]}]
(if schema
(let [->coercer (fn [t]
(let [decoder (if t (m/decoder schema options t) identity)
encoder (if t (m/encoder schema options t) identity)
validator (if validate (m/validator schema options) (constantly true))
explainer (m/explainer schema options)]
(reify p/Coercer
(-decode [_ value] (decoder value))
(-encode [_ value] (encoder value))
(-validate [_ value] (validator value))
(-explain [_ value] (explainer value)))))
{:keys [default]} (transformers type)
default-coercer (->coercer default)
coercer default-coercer]
(if (and enabled coercer)
(fn [value format]
(if coercer
(let [transformed (p/-decode coercer value)]
(if (p/-validate coercer transformed)
transformed
(let [error (p/-explain coercer transformed)]
(coercion/map->CoercionError
(assoc error :transformed transformed)))))
value))))))
(defn- -query-string-coercer
"Create coercer for query-parameters, always allows extra params and does
encoding using string-transformer."
[schema string-transformer-provider options]
(let [;; Always allow extra paramaters on query-parameters encoding
open-schema (mu/open-schema schema)
;; Do not remove extra keys
string-transformer (if (satisfies? p/TransformationProvider string-transformer-provider)
(p/-transformer string-transformer-provider (assoc options :strip-extra-keys false))
string-transformer-provider)
encoder (m/encoder open-schema options string-transformer)]
(fn [value format]
(if encoder
(encoder value)
value))))
;;
;; public api
;;
;; TODO: this is much too compöex
(def default-options
{:transformers {:body {:default default-transformer-provider}
:string {:default string-transformer-provider}}
;; set of keys to include in error messages
:error-keys #{:type :coercion :in #_:schema :value #_:errors :humanized #_:transformed}
;; support lite syntax?
:lite true
;; schema identity function (default: close all map schemas)
:compile mu/closed-schema
;; validate request & response
:validate true
;; top-level short-circuit to disable request & response coercion
:enabled true
;; strip-extra-keys (affects only predefined transformers)
:strip-extra-keys true
;; add/set default values
:default-values true
;; encode-error
:encode-error nil
;; malli options
:options nil})
(defn create
([]
(create nil))
([opts]
(let [{:keys [transformers lite compile options encode-error] :as opts} (merge default-options opts)
;; Query-string-coercer needs to construct transfomer without strip-extra-keys so it will
;; use the transformer-provider directly.
string-transformer-provider (:default (:string transformers))
transformers (walk/prewalk #(if (satisfies? p/TransformationProvider %) (p/-transformer % opts) %) transformers)
compile (if lite (fn [schema options]
(compile (binding [l/*options* options] (l/schema schema)) options))
compile)]
^{:type ::coercion/coercion}
(reify coercion/Coercion
(-get-name [_] :malli-frontend)
(-get-options [_] opts)
(-get-model-apidocs [this specification model options]
nil)
(-get-apidocs [this specification {:keys [parameters responses] :as data}]
nil)
(-compile-model [_ model _]
(if (= 1 (count model))
(compile (first model) options)
(reduce (fn [x y] (mu/merge x y options)) (map #(compile % options) model))))
(-open-model [_ schema] schema)
(-encode-error [_ error]
;; NOTE: Is this needed for FE?
nil)
(-request-coercer [_ type schema]
(-coercer schema type transformers opts))
(-response-coercer [_ schema]
nil)
(-query-string-coercer [_ schema]
(-query-string-coercer schema string-transformer-provider opts))))))
(def coercion (create default-options))

View file

@ -10,23 +10,10 @@
[malli.transform :as mt]
[malli.util :as mu]
[reitit.coercion :as coercion]
[clojure.string :as string]))
;;
;; coercion
;;
(defprotocol Coercer
(-decode [this value])
(-encode [this value])
(-validate [this value])
(-explain [this value]))
(defprotocol TransformationProvider
(-transformer [this options]))
[reitit.coercion.malli.protocols :as p]))
(defn- -provider [transformer]
(reify TransformationProvider
(reify p/TransformationProvider
(-transformer [_ {:keys [strip-extra-keys default-values]}]
(mt/transformer
(if strip-extra-keys (mt/strip-extra-keys-transformer))
@ -44,7 +31,7 @@
encoder (if t (m/encoder schema options t) identity)
validator (if validate (m/validator schema options) (constantly true))
explainer (m/explainer schema options)]
(reify Coercer
(reify p/Coercer
(-decode [_ value] (decoder value))
(-encode [_ value] (encoder value))
(-validate [_ value] (validator value))
@ -59,20 +46,20 @@
;; decode: decode -> validate
(fn [value format]
(if-let [coercer (get-coercer format)]
(let [transformed (-decode coercer value)]
(if (-validate coercer transformed)
(let [transformed (p/-decode coercer value)]
(if (p/-validate coercer transformed)
transformed
(let [error (-explain coercer transformed)]
(let [error (p/-explain coercer transformed)]
(coercion/map->CoercionError
(assoc error :transformed transformed)))))
value))
;; encode: decode -> validate -> encode
(fn [value format]
(let [transformed (-decode default-coercer value)]
(let [transformed (p/-decode default-coercer value)]
(if-let [coercer (get-coercer format)]
(if (-validate coercer transformed)
(-encode coercer transformed)
(let [error (-explain coercer transformed)]
(if (p/-validate coercer transformed)
(p/-encode coercer transformed)
(let [error (p/-explain coercer transformed)]
(coercion/map->CoercionError
(assoc error :transformed transformed))))
value))))))))
@ -84,8 +71,8 @@
(let [;; Always allow extra paramaters on query-parameters encoding
open-schema (mu/open-schema schema)
;; Do not remove extra keys
string-transformer (if (satisfies? TransformationProvider string-transformer-provider)
(-transformer string-transformer-provider (assoc options :strip-extra-keys false))
string-transformer (if (satisfies? p/TransformationProvider string-transformer-provider)
(p/-transformer string-transformer-provider (assoc options :strip-extra-keys false))
string-transformer-provider)
encoder (m/encoder open-schema options string-transformer)]
(fn [value format]
@ -132,7 +119,7 @@
;; Query-string-coercer needs to construct transfomer without strip-extra-keys so it will
;; use the transformer-provider directly.
string-transformer-provider (:default (:string transformers))
transformers (walk/prewalk #(if (satisfies? TransformationProvider %) (-transformer % opts) %) transformers)
transformers (walk/prewalk #(if (satisfies? p/TransformationProvider %) (p/-transformer % opts) %) transformers)
compile (if lite (fn [schema options]
(compile (binding [l/*options* options] (l/schema schema)) options))
compile)]

View file

@ -0,0 +1,10 @@
(ns reitit.coercion.malli.protocols)
(defprotocol Coercer
(-decode [this value])
(-encode [this value])
(-validate [this value])
(-explain [this value]))
(defprotocol TransformationProvider
(-transformer [this options]))