(.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 (value@ license.#patent_retaliation? termination)))) (_.test "Effective date for the grants is present." (present? grant.date)) (_.test "Patent grant is present." (present? (grant.termination (value@ license.#termination_period termination) (value@ license.#grace_period termination)))) (_.test "The termination period is accurately conveyed." (present? (grant.grant_restoration_clause (value@ license.#termination_period termination)))) (_.test "The grace period is accurately conveyed." (present? (grant.grace_period_clause (value@ 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#= (value@ license.#can_accept? liability) (present? liability.can_accept))) (_.test "Liability acceptance conditions may be present." (bit#= (value@ 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 (value@ license.#can_sell? commercial)) (present? commercial.cannot_sell))) (_.test "Contributor credit condition is present." (bit#= (value@ license.#require_contributor_credit? commercial) (present? commercial.require_contributor_attribution))) (_.test "Anti-endorsement condition is present." (bit#= (not (value@ license.#allow_contributor_endorsement? commercial)) (present? commercial.disallow_contributor_endorsement))) )) (def: (about_extension present? extension) (Concern Extension) ($_ _.and (_.test "The license is viral." (bit#= (value@ 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#= (value@ license.#must_be_distinguishable? extension) (present? extension.distinctness_requirement))) (_.test "The community must be notified of new extensions." (case (value@ license.#notification_period extension) {.#Some period} (present? (extension.notification_requirement period)) {.#None} true)) (_.test "Must describe modifications." (bit#= (value@ 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? (value@ license.#copyright_notice attribution))) (_.test "The attribution phrase is present." (|> attribution (value@ license.#phrase) (maybe#each present?) (maybe.default true))) (_.test "The attribution URL is present." (present? (value@ license.#url attribution))) (_.test "The attribution image is present." (|> attribution (value@ 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#= (value@ 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?) (value@ license.#copyright_holders license))) (_.test "Identification is present (if the license is identified)." (case (value@ 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 (value@ license.#justification black_list) {.#Some justification} (present? justification) {.#None} bit.yes) every_entity_is_mentioned? (|> black_list (value@ license.#entities) (list#each black_list.entity) (list.every? present?))] (and black_list_is_justified? every_entity_is_mentioned?))) (value@ 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? (value@ 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? (value@ license.#liability license)) (..about_distribution present? (value@ license.#distribution license)) (..about_commercial present? (value@ license.#commercial license)) (..about_extension present? (value@ license.#extension license)) (case (value@ license.#attribution license) {.#Some attribution} (..about_attribution present? attribution) {.#None} (_.test "Attribution is missing." bit.yes)) (..about_miscellaneous present?) (..about_addendum present? (value@ license.#addendum license)) (_.test "License ending footer is present." (present? notice.end_of_license)) ))) (program: args (<| io.io _.run! (_.times 100) ..test))