/
experimental.cljc
60 lines (55 loc) · 2.54 KB
/
experimental.cljc
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
(ns malli.experimental
(:refer-clojure :exclude [defn])
#?(:cljs (:require-macros malli.experimental))
(:require [clojure.core :as c]
[malli.core :as m]
[malli.destructure :as md]))
(c/defn -schema [inline-schemas]
(m/schema
[:schema
{:registry {"Schema" any?
"Separator" (if inline-schemas [:= :-] md/Never)
"Args" [:vector :any]
"PrePost" [:map
[:pre {:optional true} [:sequential any?]]
[:post {:optional true} [:sequential any?]]]
"Arity" [:catn
[:args "Args"]
[:prepost [:? "PrePost"]]
[:body [:* :any]]]
"Params" [:catn
[:name symbol?]
[:return [:? [:catn
[:- "Separator"]
[:schema "Schema"]]]]
[:doc [:? string?]]
[:meta [:? :map]]
[:arities [:altn
[:single "Arity"]
[:multiple [:catn
[:arities [:+ [:schema "Arity"]]]
[:meta [:? :map]]]]]]]}}
"Params"]))
(def SchematizedParams (-schema true))
(def Params (-schema false))
(c/defn -defn [schema args]
(let [{:keys [name return doc meta arities] :as parsed} (m/parse schema args)
_ (when (= ::m/invalid parsed) (m/-fail! ::parse-error {:schema schema, :args args}))
parse (fn [{:keys [args] :as parsed}] (merge (md/parse args) parsed))
->schema (fn [{:keys [schema]}] [:=> schema (:schema return :any)])
single (= :single (key arities))
parglists (if single (->> arities val parse vector) (->> arities val :arities (map parse)))
raw-arglists (map :raw-arglist parglists)
schema (as-> (map ->schema parglists) $ (if single (first $) (into [:function] $)))]
`(let [defn# (c/defn
~name
~@(some-> doc vector)
~(assoc meta :raw-arglists (list 'quote raw-arglists), :schema schema)
~@(map (fn [{:keys [arglist prepost body]}] `(~arglist ~prepost ~@body)) parglists)
~@(when-not single (some->> arities val :meta vector)))]
(m/=> ~name ~schema)
defn#)))
;;
;; public api
;;
#?(:clj (defmacro defn [& args] (-defn SchematizedParams args)))