aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/licentia.lux
blob: 619d9c7110df6dd0d9aa815224bb3e505fccc198 (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
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
(.module:
  [lux #*
   [cli (#+ program:)]
   ["_" test (#+ Test)]
   [abstract/monad (#+ do)]
   [io (#+ io)]
   [data
    ["." bit ("#;." equivalence)]
    ["." maybe ("#;." functor)]
    ["." text]
    [number
     ["n" nat ("#@." interval)]]
    [collection
     ["." list ("#;." functor)]]]
   [math
    ["r" random (#+ Random)]]]
  {#program
   [/
    ["." license (#+ Identification
                     Termination
                     Liability
                     Distribution
                     Commercial
                     Extension
                     Entity Black-List
                     URL Attribution
                     License)
     ["." time (#+ Period)]
     ["." copyright]
     ["." notice]
     ["." definition]
     ["." grant]
     ["." limitation]
     ["." submission]
     ["." liability]
     ["." distribution]
     ["." commercial]
     ["." extension]
     ["." miscellaneous]
     ["." black-list]]
    ["." output]]})

(def: period
  (Random (Period Nat))
  (do {@ r.monad}
    [start (r.filter (|>> (n.= n@top) not)
                     r.nat)
     #let [wiggle-room (n.- start n@top)]
     end (:: @ map
             (|>> (n.% wiggle-room) (n.max 1))
             r.nat)]
    (wrap {#time.start start
           #time.end end})))

(def: copyright-holder
  (Random copyright.Holder)
  ($_ r.and
      (r.ascii 10)
      ..period))

(def: identification
  (Random Identification)
  ($_ r.and
      (r.ascii 10)
      (r.ascii 10)))

(def: termination
  (Random Termination)
  ($_ r.and
      r.bit
      r.nat
      r.nat))

(def: liability
  (Random Liability)
  ($_ r.and
      r.bit
      r.bit))

(def: distribution
  (Random Distribution)
  ($_ r.and
      r.bit
      r.bit))

(def: commercial
  (Random Commercial)
  ($_ r.and
      r.bit
      r.bit
      r.bit))

(def: extension
  (Random Extension)
  ($_ r.and
      r.bit
      r.bit
      (r.maybe ..period)
      r.bit))

(def: entity
  (Random Entity)
  (r.ascii 10))

(def: (variable-list max-size gen-element)
  (All [a] (-> Nat (Random a) (Random (List a))))
  (do {@ r.monad}
    [amount (:: @ map (n.% (n.max 1 max-size))
                r.nat)]
    (r.list amount gen-element)))

(def: black-list
  (Random Black-List)
  ($_ r.and
      (r.maybe (r.ascii 10))
      (variable-list 10 ..entity)))

(def: url
  (Random URL)
  (r.ascii 10))

(def: attribution
  (Random Attribution)
  ($_ r.and
      (r.ascii 10)
      (r.maybe (r.ascii 10))
      ..url
      (r.maybe ..url)))

(def: license
  (Random License)
  ($_ r.and
      (r.list 2 ..copyright-holder)
      (r.maybe ..identification)
      ..termination
      ..liability
      ..distribution
      ..commercial
      ..extension
      (variable-list 3 ..black-list)
      (r.maybe attribution)))

(type: (Concern a)
  (-> (-> Text Bit) a Test))

(def: (about-grant present? termination)
  (Concern Termination)
  ($_ _.and
      (_.test "Copyright grant is present."
              (present? grant.copyright))
      (_.test "Patent grant is present."
              (present? (grant.patent (get@ #license.patent-retaliation? termination))))
      (_.test "Effective date for the grants is present."
              (present? grant.date))
      (_.test "Patent grant is present."
              (present? (grant.termination (get@ #license.termination-period termination)
                                           (get@ #license.grace-period termination))))
      (_.test "The termination period is accurately conveyed."
              (present? (grant.grant-restoration-clause (get@ #license.termination-period termination))))
      (_.test "The grace period is accurately conveyed."
              (present? (grant.grace-period-clause (get@ #license.grace-period termination))))
      (_.test "The grants are not retro-actively terminated."
              (present? grant.no-retroactive-termination))
      ))

(def: (about-liability present? liability)
  (Concern Liability)
  ($_ _.and
      (_.test "Warranty liability disclaimer is present."
              (present? liability.warranty))
      (_.test "Limitation of liability is present."
              (present? liability.limitation))
      (_.test "Litigation conditions are present."
              (present? liability.litigation))
      (_.test "Liability acceptance conditions may be present."
              (bit;= (get@ #license.can-accept? liability)
                     (present? liability.can-accept)))
      (_.test "Liability acceptance conditions may be present."
              (bit;= (get@ #license.disclaim-high-risk? liability)
                     (present? liability.disclaim-high-risk)))
      ))

(def: (about-distribution present? distribution)
  (Concern Distribution)
  ($_ _.and
      (_.test "Conditions for source-code distribution are present."
              (present? distribution.source-code-form))
      (_.test "Conditions for object-code distribution are present."
              (present? distribution.object-form))
      (_.test "Conditions for extension distribution are present."
              (present? (distribution.extension distribution)))
      ))

(def: (about-commercial present? commercial)
  (Concern Commercial)
  ($_ _.and
      (_.test "Non-commercial clause is present."
              (bit;= (not (get@ #license.can-sell? commercial))
                     (present? commercial.cannot-sell)))
      (_.test "Contributor credit condition is present."
              (bit;= (get@ #license.require-contributor-credit? commercial)
                     (present? commercial.require-contributor-attribution)))
      (_.test "Anti-endorsement condition is present."
              (bit;= (not (get@ #license.allow-contributor-endorsement? commercial))
                     (present? commercial.disallow-contributor-endorsement)))
      ))

(def: (about-extension present? extension)
  (Concern Extension)
  ($_ _.and
      (_.test "The license is viral."
              (bit;= (get@ #license.same-license? extension)
                     (and (list.every? present? extension.sharing-requirement)
                          (list.every? present? extension.license-conflict-resolution))))
      (_.test "Extensions must be distinguishable from the original work."
              (bit;= (get@ #license.must-be-distinguishable? extension)
                     (present? extension.distinctness-requirement)))
      (_.test "The community must be notified of new extensions."
              (case (get@ #license.notification-period extension)
                (#.Some period)
                (present? (extension.notification-requirement period))

                #.None
                true))
      (_.test "Must describe modifications."
              (bit;= (get@ #license.must-describe-modifications? extension)
                     (present? extension.description-requirement)))
      ))

(def: (about-attribution present? attribution)
  (Concern Attribution)
  ($_ _.and
      (_.test "The attribution copyright notice is present."
              (present? (get@ #license.copyright-notice attribution)))
      (_.test "The attribution phrase is present."
              (|> attribution
                  (get@ #license.phrase)
                  (maybe;map present?)
                  (maybe.default true)))
      (_.test "The attribution URL is present."
              (present? (get@ #license.url attribution)))
      (_.test "The attribution image is present."
              (|> attribution
                  (get@ #license.image)
                  (maybe;map present?)
                  (maybe.default true)))
      ))

(def: (about-miscellaneous present?)
  (-> (-> Text Bit) Test)
  ($_ _.and
      (_.test "License constitutes the entire agreement."
              (present? miscellaneous.entire-agreement))
      (_.test "Disclaims relationship of parties."
              (present? miscellaneous.relationship-of-parties))
      (_.test "Explicitly allows independent development."
              (present? miscellaneous.independent-development))
      (_.test "Clarifies consent to breach does not waiver."
              (present? miscellaneous.not-waiver))
      (_.test "Provides severability."
              (present? miscellaneous.severability))
      (_.test "Covers export restrictions."
              (present? miscellaneous.export-restrictions))
      ))

(def: test
  Test
  (do r.monad
    [license ..license
     #let [writ (output.license license)
           present? (: (-> Text Bit)
                       (function (_ snippet)
                         (text.contains? snippet writ)))]]
    ($_ _.and
        (_.test "Copyright notices are present."
                (list.every? (|>> notice.copyright-holder present?)
                             (get@ #license.copyright-holders license)))
        
        (_.test "Identification is present (if the license is identified)."
                (case (get@ #license.identification license)
                  (#.Some identification)
                  (and (present? (output.identification identification))
                       (present? miscellaneous.new-versions))

                  #.None
                  (not (present? miscellaneous.new-versions))))

        (_.test "Black-lists (if wanted by licensor) are explicitly enumerated and justified."
                (list.every? (function (_ black-list)
                               (let [black-list-is-justified? (case (get@ #license.justification black-list)
                                                                (#.Some justification)
                                                                (present? justification)

                                                                #.None
                                                                yes)
                                     every-entity-is-mentioned? (|> black-list
                                                                    (get@ #license.entities)
                                                                    (list;map black-list.entity)
                                                                    (list.every? present?))]
                                 (and black-list-is-justified?
                                      every-entity-is-mentioned?)))
                             (get@ #license.black-lists license)))
        
        (_.test "All definitions are present."
                (list.every? (|>> output.definition present?)
                             definition.all))

        (_.test "Acceptance of the license is demanded."
                (present? limitation.acceptance))
        
        (..about-grant present? (get@ #license.termination license))
        
        (_.test "All limitations are present."
                (present? output.limitation))
        
        (_.test "All assurances are present."
                (present? output.assurance))
        
        (_.test "The terms of submission are present."
                (present? submission.contribution))
        
        (..about-liability present? (get@ #license.liability license))

        (..about-distribution present? (get@ #license.distribution license))

        (..about-commercial present? (get@ #license.commercial license))

        (..about-extension present? (get@ #license.extension license))

        (case (get@ #license.attribution license)
          (#.Some attribution)
          (..about-attribution present? attribution)

          #.None
          (_.test "Attribution is missing."
                  yes))

        (..about-miscellaneous present?)

        (_.test "License ending footer is present."
                (present? notice.end-of-license))
        )))

(program: args
  (io (_.run! (<| (_.times 100)
                  ..test))))