From 519c0c0c71cdf7ce3dfc64b9781ab826760b3d94 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 14 Jun 2021 18:33:54 -0400 Subject: Extracted Licentia out of the standard library. --- licentia/source/test/licentia.lux | 368 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 368 insertions(+) create mode 100644 licentia/source/test/licentia.lux (limited to 'licentia/source/test') diff --git a/licentia/source/test/licentia.lux b/licentia/source/test/licentia.lux new file mode 100644 index 000000000..bf0f4929e --- /dev/null +++ b/licentia/source/test/licentia.lux @@ -0,0 +1,368 @@ +(.module: + [lux #* + [program (#+ program:)] + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + [io (#+ io)]] + [data + ["." bit ("#\." equivalence)] + ["." maybe ("#\." functor)] + ["." text] + [collection + ["." list ("#\." functor)]]] + [math + ["." random (#+ Random)] + [number + ["n" nat ("#\." interval)]]]] + {#program + [/ + ["." license (#+ Identification + Termination + Liability + Distribution + Commercial + Extension + Entity Black_List + URL Attribution + Addendum + License) + ["." time (#+ Period)] + ["." copyright] + ["." notice] + ["." definition] + ["." grant] + ["." limitation] + ["." submission] + ["." liability] + ["." distribution] + ["." commercial] + ["." extension] + ["." miscellaneous] + ["." black_list] + ["." addendum]] + ["." output]]}) + +(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 (\ ! map + (|>> (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 (\ ! map (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 (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: (about_addendum present? value) + (Concern Addendum) + ($_ _.and + (_.test "Commons clause" + (bit\= (get@ #license.commons_clause? value) + (present? addendum.commons_clause))) + )) + +(def: test + Test + (do random.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?) + + (..about_addendum present? (get@ #license.addendum license)) + + (_.test "License ending footer is present." + (present? notice.end_of_license)) + ))) + +(program: args + (io (_.run! (<| (_.times 100) + ..test)))) -- cgit v1.2.3