diff options
| author | Eduardo Julian | 2019-02-05 20:30:13 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2019-02-05 20:30:13 -0400 |
| commit | 60430ee6dfffbeb220a3e8fee7336d54313467bc (patch) | |
| tree | e00b48c2af5354392f514347547340f67f71e708 /stdlib | |
| parent | c542e618266c2f321704bef381b14213c30cc2e0 (diff) | |
Folded license-making program (legislator) into the Lux project proper (as licentia).
Diffstat (limited to 'stdlib')
23 files changed, 2169 insertions, 3 deletions
diff --git a/stdlib/project.clj b/stdlib/project.clj index 664704a50..678d5d381 100644 --- a/stdlib/project.clj +++ b/stdlib/project.clj @@ -22,6 +22,9 @@ :source-paths ["source"] :profiles {:library {:dependencies [] :lux {:tests {:jvm "test/lux"}}} - :documentation {:dependencies [] - :lux {:program {:jvm "program/scriptum"}}}} + :scriptum {:dependencies [] + :lux {:program {:jvm "program/scriptum"}}} + :licentia {:dependencies [] + :lux {:program {:jvm "program/licentia"} + :tests {:jvm "test/licentia"}}}} ) diff --git a/stdlib/source/program/licentia.lux b/stdlib/source/program/licentia.lux new file mode 100644 index 000000000..29ecc7eab --- /dev/null +++ b/stdlib/source/program/licentia.lux @@ -0,0 +1,66 @@ +## The licenses produced by this program are inspired by: +## Apache License (Version 2.0): https://www.apache.org/licenses/LICENSE-2.0 +## Mozilla Public License (Version 2.0): https://www.mozilla.org/en-US/MPL/2.0/ +## MIT/Expat License: https://opensource.org/licenses/MIT +## BSD licenses: https://en.wikipedia.org/wiki/BSD_licenses +## Commons Clause: https://commonsclause.com/ +## Reciprocal Public License 1.5 (RPL-1.5): https://opensource.org/licenses/RPL-1.5 +## The Parity Public License: https://licensezero.com/licenses/parity +## The Charity Public License: https://licensezero.com/licenses/charity +## Lerna black-list: https://github.com/lerna/lerna/pull/1616 +## Common Public Attribution License Version 1.0 (CPAL-1.0): https://opensource.org/licenses/CPAL-1.0 +## Eclipse Public License v2.0: https://www.eclipse.org/legal/epl-2.0/ + +(.module: + [lux #* + [control + [monad (#+ do)] + ["." parser]] + [data + ["." maybe] + ["." error] + ["." text + format + ["." encoding]] + [format + ["." json]]] + ["." cli (#+ program:)] + ["." io ("io/." Monad<IO>)] + [world + ["." file (#+ File)]] + [host (#+ import:)]] + [/ + ["/." input] + ["/." output]]) + +(import: #long java/lang/String + (trim [] String)) + +(def: default-output-file "LICENSE") + +(def: (success-message output) + (-> File Text) + (format "Your license has been made!" text.new-line + "Check the file " output ".")) + +(program: [{input (cli.named "--input" cli.any)} + {output (parser.default ..default-output-file + (cli.named "--output" cli.any))}] + (do io.Monad<IO> + [?done (do io.Monad<Process> + [blob (:: file.JVM@System read input) + document (io/wrap (do error.Monad<Error> + [raw-json (encoding.from-utf8 blob) + json (|> raw-json + (:coerce java/lang/String) + java/lang/String::trim + (:: json.Codec<Text,JSON> decode)) + license (json.run json /input.license)] + (wrap (/output.license license))))] + (:: file.JVM@System write (encoding.to-utf8 document) output))] + (case ?done + (#error.Success _) + (wrap (log! (success-message output))) + + (#error.Error message) + (wrap (log! message))))) diff --git a/stdlib/source/program/licentia/document.lux b/stdlib/source/program/licentia/document.lux new file mode 100644 index 000000000..bb128807b --- /dev/null +++ b/stdlib/source/program/licentia/document.lux @@ -0,0 +1,47 @@ +(.module: + [lux (#- or and) + [data + ["." text + format] + [collection + [list ("list/." functor)]]]]) + +(def: #export (quote text) + (-> Text Text) + (format text.double-quote text text.double-quote)) + +(def: #export (block content) + (-> Text Text) + (format content text.new-line text.new-line)) + +(def: #export (plural singular) + (-> Text Text) + (format singular "(s)")) + +(def: #export (sentence content) + (-> Text Text) + (format content ".")) + +(def: #export paragraph + (-> (List Text) Text) + (|>> (list/map ..sentence) + (text.join-with text.new-line))) + +(do-template [<name> <word>] + [(def: #export <name> + (-> (List Text) Text) + (text.join-with (format ", " <word> " ")))] + + [or "or"] + [and "and"] + [and/or "and/or"] + ) + +(type: #export Section + {#title Text + #content Text}) + +(def: #export (section value) + (-> Section Text) + (format (block (get@ #title value)) + (get@ #content value))) diff --git a/stdlib/source/program/licentia/input.lux b/stdlib/source/program/licentia/input.lux new file mode 100644 index 000000000..a10452f5b --- /dev/null +++ b/stdlib/source/program/licentia/input.lux @@ -0,0 +1,148 @@ +(.module: + [lux #* + [control + [monad (#+ do)] + ["ex" exception (#+ exception:)] + ["." parser]] + [data + [text + 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" (%f amount)])) + +(exception: #export (cannot-use-negative-amount {amount Int}) + (ex.report ["Amount" (%i 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" (%n (get@ #time.start period))] + ["End" (%n (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))))) diff --git a/stdlib/source/program/licentia/license.lux b/stdlib/source/program/licentia/license.lux new file mode 100644 index 000000000..c77718ce7 --- /dev/null +++ b/stdlib/source/program/licentia/license.lux @@ -0,0 +1,58 @@ +(.module: + [lux #*] + [/ + ["/." copyright] + [time (#+ Days Months Period)]]) + +(type: #export Identification + {#name Text + #version Text}) + +(type: #export Termination + {#patent-retaliation? Bit + #termination-period Days + #grace-period Days}) + +(type: #export Liability + {#can-accept? Bit + #disclaim-high-risk? Bit}) + +(type: #export Distribution + {#can-re-license? Bit + #can-multi-license? Bit}) + +(type: #export Commercial + {#can-sell? Bit + #require-contributor-credit? Bit + #allow-contributor-endorsement? Bit}) + +(type: #export Extension + {#same-license? Bit + #must-be-distinguishable? Bit + #notification-period (Maybe (Period Months)) + #must-describe-modifications? Bit}) + +(type: #export Entity Text) + +(type: #export Black-List + {#justification (Maybe Text) + #entities (List Entity)}) + +(type: #export URL Text) + +(type: #export Attribution + {#copyright-notice Text + #phrase (Maybe Text) + #url URL + #image (Maybe URL)}) + +(type: #export License + {#copyright-holders (List /copyright.Holder) + #identification (Maybe Identification) + #termination Termination + #liability Liability + #distribution Distribution + #commercial Commercial + #extension Extension + #black-lists (List Black-List) + #attribution (Maybe Attribution)}) diff --git a/stdlib/source/program/licentia/license/assurance.lux b/stdlib/source/program/licentia/license/assurance.lux new file mode 100644 index 000000000..c75598962 --- /dev/null +++ b/stdlib/source/program/licentia/license/assurance.lux @@ -0,0 +1,25 @@ +(.module: + [lux #* + [data + ["." text + format]]] + [// + ["_" term] + [// + ["$" document]]]) + +(def: #export representation + ($.sentence (format "Each " _.contributor + " represents that the " _.contributor + " believes its " ($.plural _.contribution) + " are its original creation(s) or it has sufficient rights to grant the rights to its " ($.plural _.contribution) + " conveyed by " _.license))) + +(def: #export fair-use + (let [copyright-doctrines (: (List Text) + (list "fair use" + "fair dealing" + "other equivalents"))] + ($.sentence (format _.license + " is not intended to limit any rights " _.recipient + " has under applicable copyright doctrines of " ($.or copyright-doctrines))))) diff --git a/stdlib/source/program/licentia/license/black-list.lux b/stdlib/source/program/licentia/license/black-list.lux new file mode 100644 index 000000000..7f30acadf --- /dev/null +++ b/stdlib/source/program/licentia/license/black-list.lux @@ -0,0 +1,31 @@ +(.module: + [lux #* + [data + ["." maybe ("maybe/." functor)] + ["." text + format] + [collection + ["." list ("list/." functor)]]]] + ["." // (#+ Entity Black-List) + ["_" term] + [// + ["$" document]]]) + +(def: #export entity + (-> Entity Text) + %t) + +(def: #export (black-list black-list) + (-> Black-List Text) + (let [scope (format "The rights granted under " _.license) + effect "shall not be granted to the following entities, or any subsidiary thereof" + justification (|> black-list + (get@ #//.justification) + (maybe/map (|>> (format ", due to "))) + (maybe.default "")) + entities (|> black-list + (get@ #//.entities) + (list/map ..entity) + (text.join-with text.new-line))] + (format scope " " effect justification ":" text.new-line + entities))) diff --git a/stdlib/source/program/licentia/license/commercial.lux b/stdlib/source/program/licentia/license/commercial.lux new file mode 100644 index 000000000..a80ccbde2 --- /dev/null +++ b/stdlib/source/program/licentia/license/commercial.lux @@ -0,0 +1,30 @@ +(.module: + [lux #* + [data + ["." text + format] + [collection + [list ("list/." monoid)]]]] + ["." // (#+ Commercial) + ["_" term] + [// + ["$" document]]]) + +(def: #export cannot-sell + (let [preamble (format "Without limiting other conditions in " _.license) + condition (format "the grant of rights under " _.license + " will not include, and " _.license + " does not grant to " _.recipient + ", the right to " _.sell " " _.work)] + ($.sentence (format preamble ", " condition)))) + +(def: #export require-contributor-attribution + ($.sentence (format "All advertising materials mentioning features or use of " _.work + " must include an acknowledgement of the authorship of every " _.contributor))) + +(def: #export disallow-contributor-endorsement + (let [subject (format "The name of no " _.contributor) + capability "endorse or promote products" + source (format "any " _.extension) + condition "specific prior written permission"] + ($.sentence (format subject " may be used to " capability " derived from " source " without " condition)))) diff --git a/stdlib/source/program/licentia/license/copyright.lux b/stdlib/source/program/licentia/license/copyright.lux new file mode 100644 index 000000000..872af9d2b --- /dev/null +++ b/stdlib/source/program/licentia/license/copyright.lux @@ -0,0 +1,8 @@ +(.module: + [lux #*] + [// + [time (#+ Year Period)]]) + +(type: #export Holder + {#name Text + #period (Period Year)}) diff --git a/stdlib/source/program/licentia/license/definition.lux b/stdlib/source/program/licentia/license/definition.lux new file mode 100644 index 000000000..681f521e7 --- /dev/null +++ b/stdlib/source/program/licentia/license/definition.lux @@ -0,0 +1,240 @@ +(.module: + [lux (#- Definition) + [data + ["." text + format]]] + [/// + ["$" document]]) + +(type: #export Definition + {#term Text + #meaning Text}) + +(def: not-a-contribution-notice + (format text.double-quote "Not a Contribution" text.double-quote)) + +(def: #export patent-rights + (List Text) + (list "make" + "have made" + "use" + "offer to sell" + "sell" + "import" + "transfer")) + +(def: commercial-services + (List Text) + (let [services (: (-> Text Text) + (function (_ type) + (format type " services")))] + (list (services "hosting") + (services "consulting") + (services "support")))) + +(def: individual-capacities + (List Text) + (list "officer" + "employee" + "member" + "independent contractor" + "agent of a corporation, business or organization (commercial or non-commercial)")) + +(def: covered-work-description + "work of authorship") + +(do-template [<name> <term> <meaning>] + [(def: #export <name> + Definition + {#term <term> + #meaning <meaning>})] + + [license "This License" + ($.paragraph (list (format "the terms and conditions defined in this document")))] + + [licensable "Licensable" + ($.paragraph (list (format "having the right to grant any and all of the rights conveyed by " (get@ #term license))))] + + [legal-entity "Legal Entity" + (let [abilities (: (List Text) + (list "to enter into contracts" + "to sue" + "to be sued"))] + ($.paragraph (list (format "any human or non-human entity that is recognized as having privileges and obligations, such as having the ability " ($.and abilities)))))] + + [recipient "Recipient" + ($.paragraph (list (format "a " (get@ #term legal-entity) " exercising permissions by " (get@ #term license))))] + + [licensor "The Licensor" + ($.paragraph (list (format "the copyright owner granting " (get@ #term license) ", or a " (get@ #term legal-entity) " authorized by the copyright owner")))] + + [source-code-form "Source Code Form" + ($.paragraph (list (format "the preferred form of the " ..covered-work-description " in order to make modifications to it")))] + + [object-form "Object Form" + ($.paragraph (list (format "any form produced by transforming a " (get@ #term source-code-form) ", including but not limited to compiled code and transpiled code")))] + + [work "The Work" + ($.paragraph (list (format "the " ..covered-work-description + ", whether in a " (get@ #term source-code-form) + " or in an " (get@ #term object-form) + ", made available under " (get@ #term license) + ", as indicated by a copyright notice that is included in or attached to the " ..covered-work-description)))] + + [derivative-work "Derivative Work" + ($.paragraph (list (format "any work, whether in a " (get@ #term source-code-form) + " or in an " (get@ #term object-form) + ", that is based on (or derived from) " (get@ #term work) + " and which represents an original " ..covered-work-description)))] + + [submission "Submission" + (let [forms-of-communication (: (List Text) + (list "electronic" + "verbal" + "written"))] + ($.paragraph (list (format "any form of " ($.or forms-of-communication) " communication sent to " (get@ #term licensor) + ", or its representatives, for the purpose of discussing and improving " (get@ #term work) + ", but excluding communication that is designated in writing by the copyright owner as " not-a-contribution-notice))))] + + [modification "Modification" + (let [alteration "any addition to, or deletion from, the substance or structure of" + object "file or other storage" + targets (: (List Text) + (list (format "a " object " contained in " (get@ #term work)) + (format "any new " object " that contains any part of " (get@ #term work)) + (format "any " object " which replaces or otherwise alters the original functionality of "(get@ #term work) " at runtime")))] + ($.paragraph (list (format alteration " " ($.or targets)))))] + + [required-component "Required Component" + (let [possibilities (: (List Text) + (list "text" + "program" + "script" + "schema" + "interface definition" + "control file" + "other work"))] + ($.paragraph (list (format "any " ($.or possibilities) + " created by " (get@ #term recipient) + " which is required by a third party to successfully install and run a " (get@ #term derivative-work) + " by " (get@ #term recipient)))))] + + [extension "Extension" + (let [possibilities (: (List Text) + (list (get@ #term modification) + (get@ #term derivative-work) + (get@ #term required-component)))] + ($.paragraph (list (format "any " ($.or possibilities)))))] + + [contribution "Contribution" + ($.paragraph (list (format "any " covered-work-description ", including the original version of " (get@ #term work) + " and any " (get@ #term extension) " to " (get@ #term work) + ", that is intentionally communicated as a " (get@ #term submission) + " to " (get@ #term licensor) + " for inclusion in " (get@ #term work) " by the copyright owner" + ", or by a " (get@ #term legal-entity) " authorized to submit on behalf of the copyright owner")))] + + [contributor "Contributor" + ($.paragraph (list (format (get@ #term licensor) + " or any " (get@ #term legal-entity) + " on behalf of whom a " (get@ #term contribution) + " has been received by " (get@ #term licensor) + ", and subsequently incorporated within " (get@ #term work))))] + + [patent-claim (format "Patent Claim Of A " (get@ #term contributor)) + (let [claim-types (: (List Text) + (list "method" + "process" + "apparatus"))] + ($.paragraph (list (format "any patent claim(s), including without limitation " ($.and claim-types) " claims, in any patent " + (get@ #term licensable) " by such " (get@ #term contributor) + " that would be infringed, but for the grant of " (get@ #term license) + ", to " ($.or patent-rights) " its " (get@ #term contribution)))))] + + [secondary-license "Secondary License" + ($.paragraph (list (format "any license for which compliance does not imply or require violating the terms of " (get@ #term license))))] + + [sell "Sell" + ($.paragraph (list (format "practicing any or all of the rights granted to " (get@ #term recipient) + " under " (get@ #term license) + " to provide to third parties, for a fee or other consideration " + "(including without limitation fees for " ($.or commercial-services) + " related to "(get@ #term work) ")" + ", a product or service whose value derives, entirely or substantially, from the functionality of " (get@ #term work))))] + + [personal-use "Personal Use" + (let [valid-purposes (: (List Text) + (list "personal" + "private" + "non-commercial"))] + ($.paragraph (list (format "use of " (get@ #term work) " by an individual solely for his or her " ($.and valid-purposes) " purposes") + (format "An individual's use of " (get@ #term work) " in his or her capacity as an " ($.or individual-capacities) " does not qualify"))))] + + [serve "Serve" + ($.paragraph (list (format "to deliver " (get@ #term work) + " and/or any " (get@ #term extension) + " by means of a computer network to one or more computers for purposes of execution of " (get@ #term work) + ", and/or the " (get@ #term extension))))] + + [research "Research" + ($.paragraph (list (format "investigation or experimentation for the purpose of understanding the nature and limits of " (get@ #term work) " and its potential uses")))] + + [deploy "Deploy" + (let [deployment-types (: (List Text) + (list "use" + (get@ #term serve) + "sublicense" + "distribute")) + sub-licensing (: (-> Text Text) + (function (_ type) + (format type " sublicensing"))) + third-party-interactions (: (List Text) + (list (sub-licensing "direct") + (sub-licensing "indirect") + "distribution")) + basic-definition (format "to " ($.or deployment-types) + " " (get@ #term work) + " other than for internal " (get@ #term research) + " and/or " (get@ #term personal-use) + " by " (get@ #term recipient)) + examples (format "any and all internal use or distribution of " (get@ #term work) + " within a business or organization in which " (get@ #term recipient) + " participates") + exceptions (format "for " (get@ #term research) " and/or " (get@ #term personal-use))] + ($.paragraph (list (format basic-definition + ", and includes without limitation, " examples + ", other than " exceptions + ", as well as " ($.or third-party-interactions) + " of " (get@ #term work) + " by " (get@ #term recipient) + " to any third party in any form or manner"))))] + + [electronic-distribution-mechanism "Electronic Distribution Mechanism" + ($.paragraph (list "a mechanism generally accepted in the software development community for the electronic transfer of data, such as download from an FTP server or web site, where such mechanism is publicly accessible"))] + ) + +(def: #export all + (List Definition) + (list license + licensable + legal-entity + recipient + licensor + source-code-form + object-form + work + derivative-work + submission + modification + required-component + extension + contribution + contributor + patent-claim + secondary-license + sell + personal-use + serve + research + deploy + electronic-distribution-mechanism)) diff --git a/stdlib/source/program/licentia/license/distribution.lux b/stdlib/source/program/licentia/license/distribution.lux new file mode 100644 index 000000000..346f3a3b4 --- /dev/null +++ b/stdlib/source/program/licentia/license/distribution.lux @@ -0,0 +1,112 @@ +(.module: + [lux #* + [data + ["." text + format] + [collection + [list ("list/." monoid)]]]] + ["." // (#+ Distribution) + ["_" term] + [// + ["$" document]]]) + +(def: notices + (List Text) + (let [notices (: (-> Text Text) + (function (_ what) + (format what " notices")))] + (list (notices "copyright") + (notices "patent") + (notices "trademark") + (notices "attribution") + (notices "disclaimer of warranty") + (notices "limitation of liability") + (notices "other")))) + +(def: #export source-code-form + (let [on-license-propagation (let [coverage (format "All distribution of " _.work " in " _.source-code-form) + with-contributions (format "including any " ($.plural _.contribution) + " that " _.recipient + " creates") + same-license (format "must be under the terms of " _.license)] + (format coverage ", " with-contributions ", " same-license)) + on-license-access (let [responsibility-to-inform (format _.recipient + " must inform recipients that the " _.source-code-form + " of " _.work + " is governed by the terms of " _.license) + license-copy (format "and how they can obtain a copy of " _.license)] + (format responsibility-to-inform ", " license-copy)) + on-license-immutability (format _.recipient + " may not attempt to alter or restrict the recipients’ rights in the " _.source-code-form + ", as specified in " _.license) + on-notice-retention (let [obligation (format _.recipient " must retain") + location (format "in the " _.source-code-form + " of any " _.extension + " that " _.recipient + " distributes") + what (format "all " ($.and notices) " from the " _.source-code-form " of " _.work) + exclusion ($.or (list (format "those notices that do not pertain to any part of the " _.extension) + "those notices that contain known factual inaccuracies"))] + (format obligation ", " location ", " what ", excluding " exclusion)) + on-additional-notices (let [right (format _.recipient + " may add additional "($.and notices) + " within an " _.extension + " that " _.recipient + " distributes") + constraint (format "such additional " ($.and notices) " cannot be construed as modifying " _.license)] + (format right ", provided that " constraint))] + ($.paragraph (list on-license-propagation + on-license-access + on-license-immutability + on-notice-retention + on-additional-notices)))) + +(def: #export object-form + (let [on-responsibility (let [condition (format "If " _.recipient + " distributes " _.work + " in " _.object-form) + responsibility (let [availability-responsibility (format _.work " must also be made available in " _.source-code-form) + source-code-responsibility (format _.recipient + " must inform recipients of the " _.object-form + " how they can obtain a copy of such " _.source-code-form) + constraints "by reasonable means in a timely manner, at a charge no more than the cost of distribution to the recipient"] + (format availability-responsibility ", and " source-code-responsibility " " constraints))] + (format condition " then " responsibility)) + on-licensing (format _.recipient + " may distribute such " _.object-form + " under the terms of "_.license)] + ($.paragraph (list on-responsibility + on-licensing)))) + +(def: #export allow-re-licensing + (let [can-license (format _.recipient + " may create and distribute an " _.extension + " under terms " _.recipient + " chooses") + requirement (format _.recipient + " also comply with the requirements of " _.license + " for the " _.work)] + (format can-license ", " "provided that " requirement))) + +(def: #export allow-multi-licensing + (let [condition (format "the " _.extension " is a combination of " _.work " with a work governed by one or more " ($.plural _.secondary-license)) + permission (let [relicensing (format _.license + " permits " _.recipient + " to additionally distribute " _.work + " under the terms of such " ($.plural _.secondary-license)) + distribution (format "so that the recipient of the " _.extension + " may, at their option, further distribute " _.work + " under the terms of either " _.license + " or such " ($.plural _.secondary-license))] + (format relicensing ", " distribution))] + (format "If " condition ", " permission))) + +(def: #export (extension distribution) + (-> Distribution Text) + ($.paragraph ($_ list/compose + (if (get@ #//.can-re-license? distribution) + (list allow-re-licensing) + (list)) + (if (get@ #//.can-multi-license? distribution) + (list allow-multi-licensing) + (list))))) diff --git a/stdlib/source/program/licentia/license/extension.lux b/stdlib/source/program/licentia/license/extension.lux new file mode 100644 index 000000000..1ce3bfccc --- /dev/null +++ b/stdlib/source/program/licentia/license/extension.lux @@ -0,0 +1,168 @@ +(.module: + [lux #* + [data + ["." text + format] + [collection + [list ("list/." monoid)]]]] + ["." // (#+ Extension) + ["_" term] + ["." grant] + [time (#+ Months Period)] + [// + ["$" document]]]) + +(def: #export sharing-requirement + (List Text) + (let [on-extension (let [constraint (let [because "In consideration of, and as an express condition to, " + source (format "the licenses granted to " _.recipient + " under " _.license)] + (format because " " source)) + duty (format _.recipient + " hereby agrees that any " _.extension + " that " _.recipient + " creates or to which " _.recipient + " contributes are governed by the terms of " _.license)] + (format constraint ", " duty)) + on-deployment (format _.recipient " may only " _.deploy + " an " _.extension + " that " _.recipient + " creates under the terms of " _.license) + on-sharing (format _.recipient + " hereby grant to " _.licensor + " and all third parties a " ($.and grant.grant-characteristics) + " license under those intellectual property rights " _.recipient + " owns or controls to " ($.or grant.copyright-grant-rights) + " " _.work + " in any form") + on-license-propagation (format _.recipient + " must include a copy of " _.license + " or directions on how to obtain a copy with every copy of an " _.extension + " " _.recipient " distributes") + on-license-protection (format _.recipient + " agrees not to offer or impose any terms on any " _.source-code-form + " or " _.object-form + " of the " _.work + ", or its " _.extension + " that alter or restrict the applicable version of " _.license + " or the recipients' rights hereunder")] + (list on-extension + on-deployment + on-sharing + on-license-propagation + on-license-protection))) + +(def: #export license-conflict-resolution + (List Text) + (let [on-other-licenses (let [circumstance (format "Where any portion of an " _.extension + " created by " _.recipient) + consequence "fall under the terms of another license" + duty "the terms of that license should be honored"] + (format circumstance " " consequence ", " duty)) + on-this-license (format "However " _.recipient + " must also make the " _.extension + " available under " _.license) + on-licensor-judgement (let [condition (format "the terms of " _.license " continue to conflict with the terms of the other license") + right (format _.recipient " may write " _.licensor " for permission to resolve the conflict") + characteristic (format "a fashion that remains consistent with the intent of " _.license)] + (format "If " condition ", " right " in " characteristic)) + on-licensor-discretion (format "Such permission will be granted at the sole discretion of " _.licensor)] + (list on-other-licenses + on-this-license + on-licensor-judgement + on-licensor-discretion))) + +(def: #export distinctness-requirement + ($.paragraph (list (format "Any " _.extension + " " _.recipient + " does make and " _.deploy + " must have a distinct title so as to readily tell any subsequent user or " _.contributor + " that the " _.extension + " is by " _.recipient)))) + +(def: news-sources + (List Text) + (list "news groups" + "mailing lists" + "weblogs" + "other sites")) + +(def: #export (notification-requirement [start end]) + (-> (Period Months) Text) + (let [on-availability (format _.recipient + " must notify the software community of the availability of the " _.source-code-form + " to any " _.extension + " created by " _.recipient + " within " (%n start) + " month(s) of the date " _.recipient + " initially does " _.deploy + ", and include in such notification a description of the " _.extension + ", and instructions on how to acquire the " _.source-code-form + " via an " _.electronic-distribution-mechanism) + on-duration (format "The " _.source-code-form + " must remain available via an " _.electronic-distribution-mechanism + " for no less than " (%n end) + " month(s) after the date " _.recipient + " ceases to " _.deploy) + on-responsibility (format _.recipient + " is responsible for ensuring that the " _.source-code-form + " to each " _.extension + " " _.recipient + " does " _.deploy + " remains available even if the " _.electronic-distribution-mechanism + " is maintained by a third party") + on-costs (format _.recipient + " may not charge a fee for any copy of the " _.source-code-form + " in excess of the actual cost of duplication and distribution of said copy that " _.recipient + " incurs") + on-changes (format "Should such instructions change, " _.recipient + " must notify the software community of revised instructions within " (%n start) + " month(s) of the date of change") + on-accesibility (format _.recipient + " must provide notification by posting to appropriate " ($.or news-sources) + " where a publicly accessible search engine would reasonably be expected to index a post in relationship to queries regarding " _.work + " and/or an " _.extension + " created by " _.recipient)] + ($.paragraph (list on-availability + on-duration + on-responsibility + on-costs + on-changes + on-accesibility)))) + +(def: #export description-requirement + Text + (let [on-duty (let [basic (format _.recipient + " must cause any " _.modification + " that " _.recipient + " creates, or to which " _.recipient + " contributes, to be documented in the " _.source-code-form) + modification-types (: (List Text) + (list "additions" + "changes" + "deletions")) + details (format "clearly describing the " ($.and modification-types) + " that " _.recipient " made")] + (format basic ", " details)) + on-notice-location (let [statement-locations (: (List Text) + (list (format "in the " _.source-code-form) + (format "in any notice displayed by " _.work + " " _.recipient + " distributes") + (format "in related documentation in which " _.recipient + " describes the origin or ownership of " _.work)))] + (format _.recipient + " must include a prominent statement that the " _.modification + " is derived, directly or indirectly, from " _.work + " and include the names of " _.licensor + " and any " _.contributor + " to " _.work + " " ($.and statement-locations))) + on-notice-preservation (format _.recipient + " may not modify or delete any pre-existing copyright notices, change notices or the text of " _.license + " in " _.work + " without written permission of " _.licensor + " or the respective " _.contributor)] + ($.paragraph (list on-duty + on-notice-location + on-notice-preservation)))) diff --git a/stdlib/source/program/licentia/license/grant.lux b/stdlib/source/program/licentia/license/grant.lux new file mode 100644 index 000000000..1725755b7 --- /dev/null +++ b/stdlib/source/program/licentia/license/grant.lux @@ -0,0 +1,128 @@ +(.module: + [lux #* + [data + ["." text + format]]] + [// + [time (#+ Days)] + ["_" term] + ["." definition] + [// + ["$" document]]]) + +(def: grant-header + (format "Subject to the terms and conditions of " _.license + ", each " _.contributor + " hereby grants to " _.recipient)) + +(def: #export grant-characteristics + (List Text) + (list "perpetual" + "world-wide" + "non-exclusive" + "no-charge" + "royalty-free" + "irrevocable")) + +(def: #export copyright-grant-rights + (List Text) + (list "use" + "reproduce" + "display" + "perform" + "modify" + (format "create an " _.extension " of") + "sublicense" + "distribute")) + +(def: #export copyright + ($.sentence (format grant-header " a " ($.and ..grant-characteristics) + " copyright license to " ($.or ..copyright-grant-rights) + " " _.work + " and such an " _.extension + " in a " _.source-code-form + " or an " _.object-form))) + +(def: #export (patent retaliation?) + (-> Bit Text) + (let [grant (format grant-header " a " ($.and ..grant-characteristics) + " patent license to " ($.or definition.patent-rights) " " + _.work + ", where such license applies only to any " _.patent-claim + " that is necessarily infringed by their " ($.plural _.contribution) + " alone or by combination of their " ($.plural _.contribution) + " with " _.work) + retaliation-clause (format "If " _.recipient " institutes patent litigation against any " _.legal-entity + " (including a cross-claim or counterclaim in a lawsuit) alleging that " + _.work " or a " _.contribution + " incorporated within " _.work " constitutes direct or contributory patent infringement" + ", then any patent licenses granted to " _.recipient + " under " _.license + " for " _.work + " shall terminate as of the date such litigation is filed")] + ($.paragraph (list& grant + (if retaliation? + (list retaliation-clause) + (list)))))) + +(def: #export date + ($.sentence (format "The licenses granted in " _.license + " with respect to any " _.contribution + " become effective for each " _.contribution + " on the date the " _.contributor + " first distributes such " _.contribution))) + +(def: restoration-scope "an ongoing basis") + +(def: #export (grant-restoration-clause termination-period) + (-> Days Text) + (let [restoration-condition (format _.recipient " becomes compliant") + restored-grants (format "the rights granted under " _.license + " from a particular " _.contributor) + invalidation-condition (format "such " _.contributor + " explicitly and finally terminates the grants to " _.recipient) + complaint-period-condition (format "such " _.contributor + " fails to notify " _.recipient + " of the non-compliance by some reasonable means prior to " (%n termination-period) + " " ($.plural "day") " after " _.recipient + " has come back into compliance")] + (format "However, if " restoration-condition ", then " restored-grants " are reinstated provisionally" + ", unless and until " invalidation-condition + ", and on " ..restoration-scope ", if " complaint-period-condition))) + +(def: #export (grace-period-clause grace-period) + (-> Days Text) + (let [the-grants (format "grants to " _.recipient " from a particular " _.contributor) + automatic-restoration-conditions (let [notification (format "such " _.contributor + " notifies " _.recipient + " of the non-compliance by some reasonable means") + first-offense (format "this is the first time " _.recipient + " has received notice of non-compliance with " _.license + " from such " _.contributor) + prompt-compliance (format _.recipient + " becomes compliant prior to " (%n grace-period) + " " ($.plural "day") " after reception of the notice")] + ($.and (list notification + first-offense + prompt-compliance)))] + (format "Moreover, " the-grants + " are reinstated on " ..restoration-scope + " if " automatic-restoration-conditions))) + +(def: #export (termination termination-period grace-period) + (-> Days Days Text) + (let [on-violation-of-terms (let [what (format "The rights granted under " _.license) + when (format _.recipient " fails to comply with any of its terms")] + (format what " will terminate automatically if " when))] + ($.paragraph (list on-violation-of-terms + (..grant-restoration-clause termination-period) + (..grace-period-clause grace-period))))) + +(def: #export no-retroactive-termination + (let [situation "In the event of termination" + coverage "all end user license agreements" + exclusions "(excluding licenses to distributors and resellers)" + source (format "that have been validly granted by " _.recipient " or any distributor") + scope "hereunder prior to termination" + effect "shall survive termination"] + ($.paragraph (list (format situation ", " coverage " " exclusions " " source " " scope " " effect))))) diff --git a/stdlib/source/program/licentia/license/liability.lux b/stdlib/source/program/licentia/license/liability.lux new file mode 100644 index 000000000..598341449 --- /dev/null +++ b/stdlib/source/program/licentia/license/liability.lux @@ -0,0 +1,160 @@ +(.module: + [lux #* + [data + ["." text + format]]] + [// + ["_" term] + [// + ["$" document]]]) + +(def: warranty-communications + (List Text) + (list "expressed" + "implied" + "statutory")) + +(def: work-disclamers + (List Text) + (list "free of defects" + "merchantable" + "fit for a particular purpose" + "non-infringing")) + +(def: fixes + (List Text) + (list "servicing" + "repair" + "correction")) + +(def: #export warranty + (let [on-basics (let [applicability-escape "Unless required by applicable law or agreed to in writing" + work-provisioning (format _.licensor + " provides " _.work + ", and each " _.contributor + " provides its " ($.plural _.contribution))] + (format applicability-escape ", " + work-provisioning + " under " _.license + " on an " ($.quote "as is") + " basis, without warranty or condition of any kind, either " ($.or warranty-communications) + " including, without limitation, any warranties or conditions that " _.work + " is " ($.or work-disclamers))) + on-distribution (format _.recipient + " is solely responsible for determining the appropriateness of using or redistributing " _.work) + on-risk (format "The entire risk as to the quality and performance of " _.work + " is with " _.recipient) + on-fixes (format "Should " _.work + " prove defective in any respect, " _.recipient + ", not any " _.contributor + ", assumes the cost of any necessary " ($.or fixes)) + on-importance (format "This disclaimer of warranty constitutes an essential part of "_.license) + on-authorization (format "No use of "_.work + " is authorized under " _.license + " except under this disclaimer")] + ($.paragraph (list on-basics + on-distribution + on-risk + on-fixes + on-importance + on-authorization)))) + +(def: damage-types + (List Text) + (list "direct" + "indirect" + "special" + "incidental" + "consequential")) + +(def: damage-consequences + (List Text) + (list "lost profits" + "loss of goodwill" + "work stoppage" + "computer failure or malfunction" + "any and all other commercial damages or losses")) + +(def: #export limitation + (let [on-limit (let [exclusion "Under no circumstances and under no legal theory" + examples "whether tort (including negligence), contract, or otherwise" + applicable-law-exception "unless required by applicable law (such as deliberate and grossly negligent acts) or agreed to in writing" + renunciation (format "shall any " _.contributor + " be liable to " _.recipient) + damage-enumeration (format "for any " ($.or damage-types) " damages of any character" + " including without limitation damages for " ($.or damage-consequences)) + conscience "even if such party shall have been informed of the possibility of such damages"] + (format exclusion ", " examples ", " applicable-law-exception ", " renunciation " " damage-enumeration ", " conscience)) + on-death-exception "This limitation of liability shall not apply to liability for death or personal injury resulting from such party’s negligence to the extent applicable law prohibits such limitation" + on-jurisdictions (format "Some jurisdictions do not allow the exclusion or limitation of incidental or consequential damages, so this exclusion and limitation may not apply to " _.recipient)] + ($.paragraph (list on-limit + on-death-exception + on-jurisdictions)))) + +(def: #export litigation + (let [on-jurisdiction (format "Any litigation relating to " _.license " may be brought only in the courts of a jurisdiction where the defendant maintains its principal place of business") + on-laws "Such litigation shall be governed by laws of that jurisdiction, without reference to its conflict-of-law provisions" + on-claims "Nothing in this section shall prevent a party’s ability to bring cross-claims or counter-claims"] + ($.paragraph (list on-jurisdiction + on-laws + on-claims)))) + +(def: liability-obligations + (List Text) + (list "support" + "warranty" + "indemnity" + "other liability obligations" + (format "rights consistent with " _.license))) + +(def: #export can-accept + (let [on-acceptance-of-liability (let [condition (format "While redistributing " _.work " or " ($.plural _.extension) " thereof") + right (format _.recipient " may choose to offer, and charge a fee for, acceptance of " ($.and/or ..liability-obligations))] + (format condition ", " right)) + on-responsibility (let [but "However, in accepting such obligations" + cannot-represent-a-contributor (format _.recipient " may not act on behalf of any other " _.contributor) + can-only-represent-oneself (format "only on behalf and on sole responsibility of " _.recipient) + each-contributor (: (-> Text Text) + (function (_ responsibility) + (format responsibility " each " _.contributor))) + responsibilities (: (List Text) + (list (each-contributor "indemnify") + (each-contributor "defend") + (format (each-contributor "hold") " harmless"))) + full-responsibility-condition (format "and only if " _.recipient + " agrees to " ($.and responsibilities) + " for any liability incurred by, or claims asserted against, such " _.contributor + " by reason of acceptance of any such warranty or additional liability by " _.recipient)] + (format but ", " cannot-represent-a-contributor ", " can-only-represent-oneself ", " full-responsibility-condition))] + ($.paragraph (list on-acceptance-of-liability + on-responsibility)))) + +(def: #export disclaim-high-risk + (let [on-work (let [intentions (: (List Text) + (list "designed" + "manufactured" + "intended for use or distribution")) + hazardous-environments (: (List Text) + (list "nuclear facilities" + "aircraft navigation" + "communications systems" + "air traffic control" + "direct life support machines" + "weapons systems")) + consequences (: (List Text) + (list "death" + "personal injury" + "severe physical damage" + "environmental damage")) + disclaim (format _.work " is not fault tolerant" + ", and is not " ($.or intentions) + " as on-line control equipment in hazardous environments requiring fail-safe performance") + examples (format "such as in the operation of " ($.or hazardous-environments)) + further (format "in which the failure of " _.work " could lead directly to " ($.or consequences))] + (format disclaim ", " examples ", " further)) + on-contributors (let [claim "any express or implied warranty of fitness for high risk activities"] + (format _.licensor + " and every " _.contributor + " specifically disclaim " claim))] + ($.paragraph (list on-work + on-contributors)))) diff --git a/stdlib/source/program/licentia/license/limitation.lux b/stdlib/source/program/licentia/license/limitation.lux new file mode 100644 index 000000000..602a4f163 --- /dev/null +++ b/stdlib/source/program/licentia/license/limitation.lux @@ -0,0 +1,75 @@ +(.module: + [lux #* + [data + ["." text + format]]] + [// + ["_" term] + [// + ["$" document]]]) + +(def: #export acceptance + (let [abilities (: (List Text) + (list "use" + "copy" + "distribute" + "modify" + (format "create an " _.extension + " of either " _.work + " or any " _.extension + " created by a " _.contributor))) + acknowledgement (format _.recipient + " is not required to accept " _.license + " since " _.recipient + " has not signed it") + limitation (format "However, nothing else grants " _.recipient + " permission to " ($.or abilities)) + warning (format "These actions are prohibited by law if " _.recipient + " does not accept " _.license) + implicit-acceptance (let [activation-condition "by performing any of these actions" + acceptance (format _.recipient + " indicates that " _.recipient + " accepts " _.license) + agreement (format _.recipient " agrees to be bound by all its terms and conditions")] + (format "Therefore, " activation-condition ", " ($.and (list acceptance agreement)))) + prohibition-due-to-non-agreement (format "If " _.recipient + " does not agree with all the terms and conditions of " _.license + ", " _.recipient " can not " ($.or abilities)) + prohibition-due-to-impossibility (format "If it is impossible for " _.recipient + " to comply with all the terms and conditions of " _.license + ", then " _.recipient + " can not " ($.or abilities))] + ($.paragraph (list acknowledgement + limitation + warning + implicit-acceptance + prohibition-due-to-non-agreement + prohibition-due-to-impossibility)))) + +(def: #export grant + ($.paragraph (list (format "The licenses granted in this document are the only rights granted under " _.license) + (format "No additional rights or licenses will be implied from the distribution or licensing of " _.work + " under " _.license) + (format "No patent license is granted by a " _.contributor + " for any code that the " _.contributor + " has removed from " _.work)))) + +(def: identifiers + (List Text) + (list "trade names" + "trademarks" + "service marks" + "product names" + "logos")) + +(def: #export trademark + ($.paragraph (list (format _.license " does not grant any permission to use the " ($.or ..identifiers) + " of any " _.contributor + "; except as required for reasonable and customary use in describing the origin of " + _.work)))) + +(def: #export secondary-licenses + ($.paragraph (list (format "No " _.contributor + " makes additional grants as a result of a choice by " _.recipient + " to distribute " _.work + " under a under the terms of a " _.secondary-license)))) diff --git a/stdlib/source/program/licentia/license/miscellaneous.lux b/stdlib/source/program/licentia/license/miscellaneous.lux new file mode 100644 index 000000000..a04e3e1e2 --- /dev/null +++ b/stdlib/source/program/licentia/license/miscellaneous.lux @@ -0,0 +1,106 @@ +(.module: + [lux #* + [data + ["." text + format]]] + [// + ["_" term] + [// + ["$" document]]]) + +(def: #export entire-agreement + ($.paragraph (list (format _.license " constitutes the entire agreement between the parties with respect to the subject matter hereof")))) + +(def: #export relationship-of-parties + (let [legal-associations (: (List Text) + (list "an agency" + "a partnership" + "a joint venture" + "any other form of legal association")) + forms-of-representation (: (List Text) + (list "expressly" + "by implication" + "by appearance" + "otherwise")) + disclaimer (format _.license " will not be construed as creating " ($.or legal-associations)) + scope (format "between or among " _.recipient + ", " _.licensor + " or any " _.contributor) + constraint (format _.recipient + " will not represent to the contrary, whether " ($.or forms-of-representation))] + ($.paragraph (list (format disclaimer " " scope ", and " constraint))))) + +(def: #export independent-development + (let [actions (: (List Text) + (list "acquire" + "license" + "develop" + "subcontract" + "market" + "distribute" + "produce")) + scope (format "Nothing in " _.license) + effect (format "impair the right of " _.licensor) + target "technology or products" + compete "perform the same or similar functions as, or otherwise compete with," + competition (format "any " _.extension)] + ($.paragraph (list (format scope + " will " effect + " to " ($.or actions) + " " target + " that " compete + " " competition + " that " _.recipient + " may " ($.or actions)))))) + +(def: #export not-waiver + (let [culprits (format _.licensor " or any " _.contributor) + duty (format "enforce any provision of " _.license) + effect "a waiver of future enforcement of that or any other provision"] + ($.paragraph (list (format "Failure by " culprits + " to " duty + " will not be deemed " effect))))) + +(def: #export severability + (let [on-reformation (format "If any provision of " _.license " is held to be unenforceable, such provision shall be reformed only to the extent necessary to make it enforceable") + on-contributor-protection (format "Any law or regulation which provides that the language of a contract shall be construed against the drafter shall not be used to construe " _.license + " against a " _.contributor)] + ($.paragraph (list on-reformation + on-contributor-protection)))) + +(def: #export export-restrictions + (let [limiter "applicable laws and regulations" + limited (: (List Text) + (list "downloading" + "acquiring" + "exporting" + "reexporting")) + on-circumstances (let [limitation (format _.recipient + " may be restricted with respect to " ($.or limited)) + target (format _.work " or any underlying information or technology")] + (format limitation " " target " by " limiter)) + on-acceptance-of-responsibility (let [trigger (format "By " ($.or limited) " " _.work) + agreement (format _.recipient + " is agreeing to be responsible for compliance with all " limiter)] + (format trigger ", " agreement))] + ($.paragraph (list on-circumstances + on-acceptance-of-responsibility)))) + +(def: #export new-versions + (let [on-publishing (let [when ", from time to time," + what (format "revised versions of " _.license)] + (format _.licensor " may publish" when " " what)) + on-published-version-validity (let [condition (format _.work " has been published under a particular version of " _.license) + effect (format _.recipient " may always continue to use it under the terms of that version")] + (format "Once " condition ", " effect)) + on-license-upgrading (format _.recipient + " may also choose to use " _.work + " under the terms of any subsequent version of " _.license + " published by " _.licensor) + on-licensor-privilege (format "No one other than " _.licensor + " has the right to modify the terms applicable to " _.work + " created under " _.license)] + ($.paragraph (list on-publishing + on-published-version-validity + on-license-upgrading + on-licensor-privilege)))) diff --git a/stdlib/source/program/licentia/license/notice.lux b/stdlib/source/program/licentia/license/notice.lux new file mode 100644 index 000000000..320dd4d7c --- /dev/null +++ b/stdlib/source/program/licentia/license/notice.lux @@ -0,0 +1,30 @@ +(.module: + [lux #* + [data + ["." text + format] + [collection + [list ("list/." functor)]]]] + [// + ["//." time] + ["//." copyright] + ["_" term] + [// + ["$" document]]]) + +(def: #export end-of-license + ($.sentence "END OF TERMS AND CONDITIONS")) + +(def: #export (copyright-holder holder) + (-> //copyright.Holder Text) + (let [(^slots [#//time.start #//time.end]) (get@ #//copyright.period holder) + single-year? (n/= start end) + period-section (if single-year? + (%n start) + (format (%n start) "-" (%n end)))] + (format "Copyright (C) " period-section " " (get@ #//copyright.name holder)))) + +(def: #export copyright + (-> (List //copyright.Holder) Text) + (|>> (list/map ..copyright-holder) + (text.join-with text.new-line))) diff --git a/stdlib/source/program/licentia/license/submission.lux b/stdlib/source/program/licentia/license/submission.lux new file mode 100644 index 000000000..d700c1c1c --- /dev/null +++ b/stdlib/source/program/licentia/license/submission.lux @@ -0,0 +1,26 @@ +(.module: + [lux #* + [data + ["." text + format]]] + [// + ["_" term] + [// + ["$" document]]]) + +(def: #export contribution + (let [on-submissions (let [exception (format "Unless " _.recipient " explicitly states otherwise") + general-case (format "any intentional " _.submission " of a " _.contribution + " for inclusion in " _.work + " by " _.recipient + " to " _.licensor + " shall be under the terms and conditions of " _.license) + guard "without any additional terms or conditions"] + (format exception ", " general-case ", " guard)) + on-special-cases (let [connection "Notwithstanding the above" + prioritization (format "nothing herein shall supersede or modify the terms of any separate license agreement " _.recipient + " may have executed with " _.licensor + " regarding such " _.contribution)] + (format connection ", " prioritization))] + ($.paragraph (list on-submissions + on-special-cases)))) diff --git a/stdlib/source/program/licentia/license/term.lux b/stdlib/source/program/licentia/license/term.lux new file mode 100644 index 000000000..9e81cf666 --- /dev/null +++ b/stdlib/source/program/licentia/license/term.lux @@ -0,0 +1,37 @@ +(.module: + [lux (#- Definition) + [data + ["." text + format]]] + [// + ["." definition]]) + +(do-template [<term> <definition>] + [(def: #export <term> + Text + (get@ #definition.term <definition>))] + + [source-code-form definition.source-code-form] + [object-form definition.object-form] + [license definition.license] + [licensable definition.licensable] + [legal-entity definition.legal-entity] + [recipient definition.recipient] + [licensor definition.licensor] + [work definition.work] + [derivative-work definition.derivative-work] + [submission definition.submission] + [modification definition.modification] + [required-component definition.required-component] + [extension definition.extension] + [contribution definition.contribution] + [contributor definition.contributor] + [patent-claim definition.patent-claim] + [secondary-license definition.secondary-license] + [sell definition.sell] + [personal-use definition.personal-use] + [serve definition.serve] + [research definition.research] + [deploy definition.deploy] + [electronic-distribution-mechanism definition.electronic-distribution-mechanism] + ) diff --git a/stdlib/source/program/licentia/license/time.lux b/stdlib/source/program/licentia/license/time.lux new file mode 100644 index 000000000..22f28f607 --- /dev/null +++ b/stdlib/source/program/licentia/license/time.lux @@ -0,0 +1,15 @@ +(.module: + [lux #*]) + +(type: #export Days + Nat) + +(type: #export Months + Nat) + +(type: #export Year + Nat) + +(type: #export (Period a) + {#start a + #end a}) diff --git a/stdlib/source/program/licentia/output.lux b/stdlib/source/program/licentia/output.lux new file mode 100644 index 000000000..4f9a4ab2c --- /dev/null +++ b/stdlib/source/program/licentia/output.lux @@ -0,0 +1,306 @@ +(.module: + [lux (#- Definition) + [data + ["." maybe ("maybe/." functor)] + ["." text + format] + [collection + [list ("list/." functor monoid)]]]] + [// + ["." license (#+ Identification + Termination + Liability + Distribution + Commercial + Extension + Entity Black-List + URL Attribution + License) + ["." copyright] + ["." definition (#+ Definition)] + ["." grant] + ["." limitation] + ["." assurance] + ["." liability] + ["." distribution] + ["." commercial] + ["." extension] + ["." submission] + ["." miscellaneous] + ["." black-list] + ["." notice] + ["_" term]] + ["$" document]]) + +(def: #export (definition value) + (-> Definition Text) + (format ($.quote (get@ #definition.term value)) ": " (get@ #definition.meaning value))) + +(def: #export (identification value) + (-> Identification Text) + (format (get@ #license.name value) text.new-line + (get@ #license.version value))) + +(def: #export (grant termination) + (-> Termination Text) + (`` (format (~~ (do-template [<title> <content>] + [($.block ($.section {#$.title <title> + #$.content <content>}))] + + ["Grant of Copyright License" + grant.copyright] + + ["Grant of Patent License" + (grant.patent (get@ #license.patent-retaliation? termination))] + + ["Effective Date for the Grants" + grant.date] + + ["Grant Termination" + (grant.termination (get@ #license.termination-period termination) + (get@ #license.grace-period termination))] + + ["No Retroactive Effect of Termination" + grant.no-retroactive-termination]))))) + +(def: #export limitation + Text + (`` (format (~~ (do-template [<title> <content>] + [($.block ($.section {#$.title <title> + #$.content <content>}))] + + ["Limitations on Grant Scope" + limitation.grant] + + ["Limitations on Trademarks" + limitation.trademark] + + [(format "Limitations on " ($.plural _.secondary-license)) + limitation.secondary-licenses]))))) + +(def: #export assurance + Text + (`` (format (~~ (do-template [<title> <content>] + [($.block ($.section {#$.title <title> + #$.content <content>}))] + + ["Representation" + assurance.representation] + + ["Fair Use" + assurance.fair-use]))))) + +(def: #export (liability value) + (-> Liability Text) + (`` (format (~~ (do-template [<title> <condition> <content>] + [(if <condition> + ($.block ($.section {#$.title <title> + #$.content <content>})) + "")] + + ["Disclaimer of Warranty" + on + liability.warranty] + + ["Limitation of Liability" + on + liability.limitation] + + ["Litigation" + on + liability.litigation] + + ["Accepting Warranty or Additional Liability" + (get@ #license.can-accept? value) + liability.can-accept] + + ["High Risk Activities" + (get@ #license.disclaim-high-risk? value) + liability.disclaim-high-risk]))))) + +(def: #export (distribution distribution) + (-> Distribution Text) + (`` (format (~~ (do-template [<title> <condition> <content>] + [(if <condition> + ($.block ($.section {#$.title <title> + #$.content <content>})) + "")] + + [(format "Distribution of a " _.source-code-form) + on + distribution.source-code-form] + + [(format "Distribution of an " _.object-form) + on + distribution.object-form] + + [(format "Distribution of an " _.extension) + (or (get@ #license.can-re-license? distribution) + (get@ #license.can-multi-license? distribution)) + (distribution.extension distribution)]))))) + +(def: #export (commercial value) + (-> Commercial Text) + (`` (format (~~ (do-template [<title> <condition> <content>] + [(if <condition> + ($.block ($.section {#$.title <title> + #$.content <content>})) + "")] + + ["Non-Commerciality" + (not (get@ #license.can-sell? value)) + commercial.cannot-sell] + + [(format _.contributor " Attribution") + (get@ #license.require-contributor-credit? value) + commercial.require-contributor-attribution] + + [(format _.contributor " Endorsement") + (not (get@ #license.allow-contributor-endorsement? value)) + commercial.disallow-contributor-endorsement] + ))))) + +(def: #export (extension value) + (-> Extension Text) + (let [[show? document] (case (get@ #license.notification-period value) + (#.Some period) + [true (extension.notification-requirement period)] + + #.None + [false ""])] + (`` (format (~~ (do-template [<condition> <title> <content>] + [(if <condition> + ($.block ($.section {#$.title <title> + #$.content <content>})) + "")] + + [(get@ #license.same-license? value) "License Retention" + ($.paragraph (list/compose extension.sharing-requirement + extension.license-conflict-resolution))] + + [(get@ #license.must-be-distinguishable? value) (format _.extension " Distinctness") + extension.distinctness-requirement] + + [show? (format _.source-code-form " Availability") + document] + + [(get@ #license.must-describe-modifications? value) (format "Description of " ($.plural _.modification)) + extension.description-requirement])))))) + +(def: #export (attribution value) + (-> Attribution Text) + (let [copyright-notice (format "Attribution Copyright Notice: " (get@ #license.copyright-notice value)) + phrase (case (get@ #license.phrase value) + (#.Some phrase) + (format text.new-line "Attribution Phrase: " phrase text.new-line) + + #.None + "") + url (format text.new-line "Attribution URL: " (get@ #license.url value)) + image (case (get@ #license.image value) + (#.Some image) + (format text.new-line "Attribution Image: " image) + + #.None + "")] + (format copyright-notice + phrase + url + image))) + +(def: #export (miscellaneous identified?) + (-> Bit Text) + (`` (format (~~ (do-template [<title> <condition> <content>] + [(if <condition> + ($.block ($.section {#$.title <title> + #$.content <content>})) + "")] + + ["Entire Agreement" + on + miscellaneous.entire-agreement] + + ["Relationship of Parties" + on + miscellaneous.relationship-of-parties] + + ["Independent Development" + on + miscellaneous.independent-development] + + ["Consent To Breach Not Waiver" + on + miscellaneous.not-waiver] + + ["Severability" + on + miscellaneous.severability] + + ["Export Restrictions" + on + miscellaneous.export-restrictions] + + [(format "Versions of " _.license) + identified? + miscellaneous.new-versions] + ))))) + +(def: black-list-spacing (format text.new-line text.new-line)) + +(def: #export (license value) + (-> License Text) + (let [identification (|> value + (get@ #license.identification) + (maybe/map ..identification) + (maybe.default "")) + identified? (case (get@ #license.identification value) + (#.Some _) + true + + #.None + false)] + (`` (format ($.block identification) + ($.block (notice.copyright (get@ #license.copyright-holders value))) + + (case (get@ #license.black-lists value) + #.Nil + "" + + black-lists + ($.block ($.section {#$.title (format "Denial of " _.license) + #$.content (|> black-lists + (list/map black-list.black-list) + (text.join-with ..black-list-spacing))}))) + + ($.section {#$.title "Definitions" + #$.content (|> definition.all + (list/map (|>> ..definition $.block)) + (text.join-with ""))}) + + ($.block ($.section {#$.title (format "Acceptance of " _.license) + #$.content limitation.acceptance})) + + (..grant (get@ #license.termination value)) + ..limitation + ..assurance + + ($.block ($.section {#$.title (format _.submission " of " ($.plural _.contribution)) + #$.content submission.contribution})) + + (..liability (get@ #license.liability value)) + (..distribution (get@ #license.distribution value)) + (..commercial (get@ #license.commercial value)) + (..extension (get@ #license.extension value)) + + (|> value + (get@ #license.attribution) + (maybe/map (|>> ..attribution + ["Attribution Information"] + $.section + $.block)) + (maybe.default "")) + + (..miscellaneous identified?) + + notice.end-of-license + )))) diff --git a/stdlib/source/test/licentia.lux b/stdlib/source/test/licentia.lux new file mode 100644 index 000000000..7b723ad0e --- /dev/null +++ b/stdlib/source/test/licentia.lux @@ -0,0 +1,347 @@ +(.module: + [lux #* + [cli (#+ program:)] + ["_" test (#+ Test)] + [io (#+ io)] + [control + [monad (#+ do)]] + [data + [bit ("bit/." equivalence)] + ["." maybe ("maybe/." functor)] + [number + [nat ("nat/." interval)]] + ["." text] + [collection + ["." list ("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/= nat/top) not) + r.nat) + #let [wiggle-room (n/- start nat/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)))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 7f5253955..ef37237ba 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -370,7 +370,7 @@ "JS" on-valid-host} on-default)))))) -(def: #export test +(def: test ($_ _.and (<| (_.context "Identity.") ..identity) |