-
Notifications
You must be signed in to change notification settings - Fork 33
/
id.cljc
94 lines (80 loc) · 2.85 KB
/
id.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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
(ns ctim.generators.id
(:require [clj-momo.lib.url :as url]
[clojure.test.check.generators :as gen]
[clojure.string :as str]
[com.gfredericks.test.chuck.generators :as chuck]
[ctim.generators.common :refer [gen-str-3+
gen-char-alpha-lower]]))
(def gen-proto (gen/elements ["http" "https"]))
(def gen-ipv4-addr
(gen/fmap (fn [[a b c d]]
(str a "." b "." c "." d))
(gen/tuple (gen/choose 0 255)
(gen/choose 0 255)
(gen/choose 0 255)
(gen/choose 0 255))))
(def gen-host
(gen/frequency
#?(:clj
[[2 (chuck/string-from-regex
#"[a-zA-Z\d][-\da-zA-Z]{2,9}(\.[-\da-zA-Z]{3,10}){0,4}")]
[1 gen-ipv4-addr]]
:cljs [[2 gen-ipv4-addr]
[1 gen-ipv4-addr]])))
(def gen-port
(gen/one-of
[(gen/return nil)
(gen/choose 1000 65535)]))
(def gen-path
(gen/fmap (fn [[f s]]
(str "/" f "/" s))
(gen/tuple (gen-str-3+ gen-char-alpha-lower)
(gen-str-3+ gen-char-alpha-lower))))
(def gen-type (gen-str-3+ gen-char-alpha-lower))
(def gen-short-id
(gen/fmap (fn [[type uuid]]
(str type "-" uuid))
(gen/tuple
gen-type
gen/uuid)))
(defn gen-short-id-of-type [type]
(gen/fmap (fn [short-id-suffix]
(str (name type) "-" short-id-suffix))
gen/uuid))
(defn gen-url-id-with-parts-for-type-gen
"Given a generator for entity type, return a generator for vectors
of the components (parts) of a URL ID and the URL ID"
[custom-type-generator]
(gen/fmap (fn [[proto host port path [type short-id]]]
[{:protocol proto
:hostname host
:path-prefix path
:port port
:type type
:short-id short-id}
(str proto
"://"
host
(if port (str ":" port))
path
"/ctia/"
type
"/"
(url/encode short-id))])
(gen/tuple gen-proto
gen-host
gen-port
gen-path
(gen/fmap (fn [[type uuid]]
[type (str type "-" uuid)])
(gen/tuple custom-type-generator
gen/uuid)))))
(def gen-url-id-with-parts
(gen-url-id-with-parts-for-type-gen gen-type))
(def gen-long-id-with-parts gen-url-id-with-parts) ;; deprecated
(def gen-url-id
(gen/fmap second
gen-url-id-with-parts))
(defn gen-url-id-of-type [type-val]
(gen/fmap second
(gen-url-id-with-parts-for-type-gen (gen/return type-val))))