blob: 7af7c33d4ef52a6e96af7deb482becb2a5185e86 (
plain)
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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
|
(.module:
[lux #*
[control
[monad (#+ do)]
["ex" exception (#+ exception:)]
["." parser]]
[data
[text
["%" format (#+ format)]]
[format
["." json (#+ Reader)]]]]
[//
[license (#+ Identification
Termination
Liability
Distribution
Commercial
Extension
Entity Black-List
URL Attribution
License)
["." time (#+ Period)]
["." copyright]]])
(def: identification
(Reader Identification)
(json.object
($_ parser.and
(json.field "name" json.string)
(json.field "version" json.string))))
(exception: #export (cannot-use-fractional-amount {amount Frac})
(ex.report ["Amount" (%.frac amount)]))
(exception: #export (cannot-use-negative-amount {amount Int})
(ex.report ["Amount" (%.int amount)]))
(def: amount
(Reader Nat)
(do parser.monad
[amountF json.number
#let [amountI (frac-to-int amountF)]
_ (parser.assert (ex.construct cannot-use-fractional-amount amountF)
(f/= amountF
(int-to-frac amountI)))
_ (parser.assert (ex.construct cannot-use-negative-amount amountI)
(i/> +0 amountI))]
(wrap (.nat amountI))))
(exception: #export (invalid-period {period (Period Nat)})
(ex.report ["Start" (%.nat (get@ #time.start period))]
["End" (%.nat (get@ #time.end period))]))
(def: period
(Reader (Period Nat))
(json.object
(do parser.monad
[start (json.field "start" ..amount)
end (json.field "end" ..amount)
#let [period {#time.start start
#time.end end}]
_ (parser.assert (ex.construct invalid-period period)
(n/<= end start))]
(wrap period))))
(def: copyright-holder
(Reader copyright.Holder)
(json.object
($_ parser.and
(json.field "name" json.string)
(json.field "period" ..period))))
(def: termination
(Reader Termination)
(json.object
($_ parser.and
(json.field "patent retaliation?" json.boolean)
(json.field "termination period" ..amount)
(json.field "grace period" ..amount))))
(def: liability
(Reader Liability)
(json.object
($_ parser.and
(json.field "can accept?" json.boolean)
(json.field "disclaim high risk?" json.boolean))))
(def: distribution
(Reader Distribution)
(json.object
($_ parser.and
(json.field "can re-license?" json.boolean)
(json.field "can multi-license?" json.boolean))))
(def: commercial
(Reader Commercial)
(json.object
($_ parser.and
(json.field "can sell?" json.boolean)
(json.field "require contributor credit?" json.boolean)
(json.field "allow contributor endorsement?" json.boolean))))
(def: extension
(Reader Extension)
(json.object
($_ parser.and
(json.field "same license?" json.boolean)
(json.field "must be distinguishable?" json.boolean)
(json.field "notification period" (json.nullable ..period))
(json.field "must describe modifications?" json.boolean))))
(def: entity
(Reader Entity)
json.string)
(def: black-list
(Reader Black-List)
(json.object
($_ parser.and
(json.field "justification" (json.nullable json.string))
(json.field "entities" (json.array (parser.many ..entity))))))
(def: url
(Reader URL)
json.string)
(def: attribution
(Reader Attribution)
(json.object
($_ parser.and
(json.field "copyright-notice" json.string)
(json.field "phrase" (json.nullable json.string))
(json.field "url" ..url)
(json.field "image" (json.nullable ..url)))))
(def: #export license
(Reader License)
(json.object
($_ parser.and
(json.field "copyright-holders" (json.array (parser.many ..copyright-holder)))
(json.field "identification" (json.nullable ..identification))
(json.field "termination" ..termination)
(json.field "liability" ..liability)
(json.field "distribution" ..distribution)
(json.field "commercial" ..commercial)
(json.field "extension" ..extension)
(json.field "black-lists" (json.array (parser.some ..black-list)))
(json.field "attribution" (json.nullable ..attribution)))))
|
