aboutsummaryrefslogtreecommitdiff
path: root/licentia/source/test/licentia.lux
blob: c753cd555e2895e793826fea0a48ab6e3fa90ec9 (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
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
(.using
 [library
  [lux "*"
   [program {"+" program:}]
   ["_" test {"+" Test}]
   [abstract
    [monad {"+" do}]]
   [control
    ["[0]" io]
    ["[0]" maybe ("[1]#[0]" functor)]]
   [data
    ["[0]" bit ("[1]#[0]" equivalence)]
    ["[0]" text]
    [collection
     ["[0]" list ("[1]#[0]" functor)]]]
   [math
    ["[0]" random {"+" Random}]
    [number
     ["n" nat ("[1]#[0]" interval)]]]]]
 [\\program
  ["[0]" output]
  ["[0]" license {"+" Identification
                  Termination
                  Liability
                  Distribution
                  Commercial
                  Extension
                  Entity Black_List
                  URL Attribution
                  Addendum
                  License}
   ["[0]" time {"+" Period}]
   ["[0]" copyright]
   ["[0]" notice]
   ["[0]" definition]
   ["[0]" grant]
   ["[0]" limitation]
   ["[0]" submission]
   ["[0]" liability]
   ["[0]" distribution]
   ["[0]" commercial]
   ["[0]" extension]
   ["[0]" miscellaneous]
   ["[0]" black_list]
   ["[0]" addendum]]])

(def: period
  (Random (Period Nat))
  (do [! random.monad]
    [start (random.filter (|>> (n.= n#top) not)
                          random.nat)
     #let [wiggle_room (n.- start n#top)]
     end (# ! each
            (|>> (n.% wiggle_room) (n.max 1))
            random.nat)]
    (wrap [time.#start start
           time.#end end])))

(def: copyright_holder
  (Random copyright.Holder)
  ($_ random.and
      (random.ascii 10)
      ..period))

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

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

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

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

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

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

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

(def: (variable_list max_size gen_element)
  (All (_ a) (-> Nat (Random a) (Random (List a))))
  (do [! random.monad]
    [amount (# ! each (n.% (n.max 1 max_size))
               random.nat)]
    (random.list amount gen_element)))

(def: black_list
  (Random Black_List)
  ($_ random.and
      (random.maybe (random.ascii 10))
      (variable_list 10 ..entity)))

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

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

(def: addendum
  (Random Addendum)
  ($_ random.and
      random.bit
      ))

(def: license
  (Random License)
  ($_ random.and
      (random.list 2 ..copyright_holder)
      (random.maybe ..identification)
      ..termination
      ..liability
      ..distribution
      ..commercial
      ..extension
      (variable_list 3 ..black_list)
      (random.maybe attribution)
      ..addendum
      ))

(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 (the license.#patent_retaliation? termination))))
      (_.test "Effective date for the grants is present."
              (present? grant.date))
      (_.test "Patent grant is present."
              (present? (grant.termination (the license.#termination_period termination)
                                           (the license.#grace_period termination))))
      (_.test "The termination period is accurately conveyed."
              (present? (grant.grant_restoration_clause (the license.#termination_period termination))))
      (_.test "The grace period is accurately conveyed."
              (present? (grant.grace_period_clause (the 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#= (the license.#can_accept? liability)
                     (present? liability.can_accept)))
      (_.test "Liability acceptance conditions may be present."
              (bit#= (the 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 (the license.#can_sell? commercial))
                     (present? commercial.cannot_sell)))
      (_.test "Contributor credit condition is present."
              (bit#= (the license.#require_contributor_credit? commercial)
                     (present? commercial.require_contributor_attribution)))
      (_.test "Anti-endorsement condition is present."
              (bit#= (not (the license.#allow_contributor_endorsement? commercial))
                     (present? commercial.disallow_contributor_endorsement)))
      ))

(def: (about_extension present? extension)
  (Concern Extension)
  ($_ _.and
      (_.test "The license is viral."
              (bit#= (the 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#= (the license.#must_be_distinguishable? extension)
                     (present? extension.distinctness_requirement)))
      (_.test "The community must be notified of new extensions."
              (case (the license.#notification_period extension)
                {.#Some period}
                (present? (extension.notification_requirement period))

                {.#None}
                true))
      (_.test "Must describe modifications."
              (bit#= (the 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? (the license.#copyright_notice attribution)))
      (_.test "The attribution phrase is present."
              (|> attribution
                  (the license.#phrase)
                  (maybe#each present?)
                  (maybe.default true)))
      (_.test "The attribution URL is present."
              (present? (the license.#url attribution)))
      (_.test "The attribution image is present."
              (|> attribution
                  (the license.#image)
                  (maybe#each 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: (about_addendum present? value)
  (Concern Addendum)
  ($_ _.and
      (_.test "Commons clause"
              (bit#= (the license.#commons_clause? value)
                     (present? addendum.commons_clause)))
      ))

(def: test
  Test
  (do random.monad
    [license ..license
     #let [writ (output.license license)
           present? (is (-> Text Bit)
                        (function (_ snippet)
                          (text.contains? snippet writ)))]]
    ($_ _.and
        (_.test "Copyright notices are present."
                (list.every? (|>> notice.copyright_holder present?)
                             (the license.#copyright_holders license)))
        
        (_.test "Identification is present (if the license is identified)."
                (case (the 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 (the license.#justification black_list)
                                                                {.#Some justification}
                                                                (present? justification)

                                                                {.#None}
                                                                bit.yes)
                                     every_entity_is_mentioned? (|> black_list
                                                                    (the license.#entities)
                                                                    (list#each black_list.entity)
                                                                    (list.every? present?))]
                                 (and black_list_is_justified?
                                      every_entity_is_mentioned?)))
                             (the 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? (the 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? (the license.#liability license))

        (..about_distribution present? (the license.#distribution license))

        (..about_commercial present? (the license.#commercial license))

        (..about_extension present? (the license.#extension license))

        (case (the license.#attribution license)
          {.#Some attribution}
          (..about_attribution present? attribution)

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

        (..about_miscellaneous present?)

        (..about_addendum present? (the license.#addendum license))

        (_.test "License ending footer is present."
                (present? notice.end_of_license))
        )))

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