diff options
Diffstat (limited to 'stdlib')
41 files changed, 504 insertions, 2341 deletions
diff --git a/stdlib/project.clj b/stdlib/project.clj index 7905f82b3..81a7dc180 100644 --- a/stdlib/project.clj +++ b/stdlib/project.clj @@ -30,9 +30,5 @@ :test "test/aedifex"}} :scriptum {:description "A documentation generator for Lux code." :dependencies [] - :lux {:program "program/scriptum"}} - :licentia {:description "A program for producing free/open-source/reciprocal licenses." - :dependencies [] - :lux {:program "program/licentia" - :test "test/licentia"}}} + :lux {:program "program/scriptum"}}} ) diff --git a/stdlib/source/lux/control/function.lux b/stdlib/source/lux/control/function.lux index d9b8e36c5..855f585c9 100644 --- a/stdlib/source/lux/control/function.lux +++ b/stdlib/source/lux/control/function.lux @@ -6,9 +6,8 @@ (def: #export identity {#.doc (doc "Identity function." "Does nothing to its argument and just returns it." - (let [value "foo"] - (is? (identity value) - value)))} + (is? (identity value) + value))} (All [a] (-> a a)) (|>>)) diff --git a/stdlib/source/lux/control/function/mutual.lux b/stdlib/source/lux/control/function/mutual.lux new file mode 100644 index 000000000..705545896 --- /dev/null +++ b/stdlib/source/lux/control/function/mutual.lux @@ -0,0 +1,242 @@ +(.module: + [lux (#- Definition let def:) + ["." meta] + [abstract + ["." monad (#+ do)]] + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)] + ["<>" parser ("#\." monad) + ["<.>" code (#+ Parser)]]] + [data + ["." product] + [text + ["%" format (#+ format)]] + [collection + ["." list ("#\." functor)] + [dictionary + ["." plist (#+ PList)]]]] + ["." macro + ["." code] + [syntax (#+ syntax:) + ["." export] + ["." declaration (#+ Declaration)]]]] + ["." //]) + +(type: Mutual + {#declaration Declaration + #type Code + #body Code}) + +(.def: mutual + (Parser [Declaration Code Code]) + ($_ <>.and + declaration.parser + <code>.any + <code>.any + )) + +(.def: (mutual_definition context g!context [g!name mutual]) + (-> (List Code) Code [Code Mutual] Code) + (` (function ((~ g!name) (~ g!context)) + (.let [[(~+ context)] (~ g!context)] + (function (~ (declaration.format (get@ #declaration mutual))) + (~ (get@ #body mutual))))))) + +(exception: #export (unknown_module {module Text}) + (exception.report + ["Module" (%.text module)])) + +(template [<name>] + [(exception: #export (<name> {module Text} {definition Text}) + (exception.report + ["Module" (%.text module)] + ["Definition" (%.text definition)]))] + + [cannot_shadow_definition] + [unknown_definition] + ) + +(.def: (with_module name body) + (All [a] (-> Text (-> Module (Try [Module a])) (Meta a))) + (function (_ compiler) + (case (|> compiler (get@ #.modules) (plist.get name)) + (#.Some module) + (case (body module) + (#try.Success [module' output]) + (#try.Success [(update@ #.modules (plist.put name module') compiler) + output]) + + (#try.Failure error) + (#try.Failure error)) + + #.None + (exception.throw ..unknown_module [name])))) + +(.def: (push_one [name macro]) + (-> [Name Macro] (Meta Any)) + (do meta.monad + [[module_name definition_name] (meta.normalize name) + #let [definition (: Global (#.Definition [false .Macro (' {}) macro])) + add_macro! (: (-> (PList Global) (PList Global)) + (plist.put definition_name definition))]] + (..with_module module_name + (function (_ module) + (case (|> module (get@ #.definitions) (plist.get definition_name)) + #.None + (#try.Success [(update@ #.definitions add_macro! module) + []]) + + (#.Some _) + (exception.throw ..cannot_shadow_definition [module_name definition_name])))))) + +(.def: (pop_one name) + (-> Name (Meta Any)) + (do meta.monad + [[module_name definition_name] (meta.normalize name) + #let [remove_macro! (: (-> (PList Global) (PList Global)) + (plist.remove definition_name))]] + (..with_module module_name + (function (_ module) + (case (|> module (get@ #.definitions) (plist.get definition_name)) + (#.Some _) + (#try.Success [(update@ #.definitions remove_macro! module) + []]) + + #.None + (exception.throw ..unknown_definition [module_name definition_name])))))) + +(.def: (pop_all macros self) + (-> (List Name) Name Macro) + (<| (:coerce Macro) + (: Macro') + (function (_ _) + (do {! meta.monad} + [_ (monad.map ! ..pop_one macros) + _ (..pop_one self) + compiler meta.get_compiler] + (wrap (case (get@ #.expected compiler) + (#.Some _) (list (' [])) + #.None (list))))))) + +(.def: (push_all macros) + (-> (List [Name Macro]) (Meta Code)) + (do meta.monad + [_ (monad.map meta.monad ..push_one macros) + seed meta.count + g!pop (macro.gensym "pop") + _ (.let [g!pop (: Name ["" (%.code g!pop)])] + (..push_one [g!pop (..pop_all (list\map product.left macros) g!pop)]))] + (wrap (` ((~ g!pop)))))) + +(.def: (macro g!context g!self) + (-> Code Code Macro) + (<| (:coerce Macro) + (: Macro') + (function (_ parameters) + (\ meta.monad wrap (list (` (((~ g!self) (~ g!context)) (~+ parameters)))))))) + +(syntax: #export (let {functions (<code>.tuple (<>.some ..mutual))} + body) + (case functions + #.Nil + (wrap (list body)) + + (#.Cons mutual #.Nil) + (.let [g!name (|> mutual (get@ [#declaration #declaration.name]) code.local_identifier)] + (wrap (list (` (.let [(~ g!name) (: (~ (get@ #type mutual)) + (function (~ (declaration.format (get@ #declaration mutual))) + (~ (get@ #body mutual))))] + (~ body)))))) + + _ + (macro.with_gensyms [g!context g!output] + (do {! meta.monad} + [here_name meta.current_module_name + hidden_names (monad.map ! (//.constant (macro.gensym "mutual_function#")) + functions) + #let [definitions (list\map (..mutual_definition hidden_names g!context) + (list.zip/2 hidden_names + functions)) + context_types (list\map (function (_ mutual) + (` (-> (~ g!context) (~ (get@ #type mutual))))) + functions) + user_names (list\map (|>> (get@ [#declaration #declaration.name]) code.local_identifier) + functions)] + g!pop (..push_all (list\map (function (_ [g!name mutual]) + [[here_name (get@ [#declaration #declaration.name] mutual)] + (..macro g!context g!name)]) + (list.zip/2 hidden_names + functions)))] + (wrap (list (` (.let [(~ g!context) (: (Rec (~ g!context) + [(~+ context_types)]) + [(~+ definitions)]) + [(~+ user_names)] (.let [[(~+ user_names)] (~ g!context)] + [(~+ (list\map (function (_ g!name) + (` ((~ g!name) (~ g!context)))) + user_names))]) + (~ g!output) (~ body)] + (exec (~ g!pop) + (~ g!output)))))))))) + +(type: Definition + {#exported? Bit + #mutual Mutual}) + +(.def: definition + (Parser Definition) + (<code>.tuple (<>.and export.parser + ..mutual))) + +(syntax: #export (def: {functions (<>.many ..definition)}) + (case functions + #.Nil + (wrap (list)) + + (#.Cons definition #.Nil) + (.let [(^slots [#exported? #mutual]) definition + (^slots [#declaration #type #body]) mutual] + (wrap (list (` (.def: + (~+ (export.format exported?)) + (~ (declaration.format declaration)) + (~ type) + (~ body)))))) + + _ + (macro.with_gensyms [g!context g!output] + (do {! meta.monad} + [here_name meta.current_module_name + hidden_names (monad.map ! (//.constant (macro.gensym "mutual_function#")) + functions) + #let [definitions (list\map (..mutual_definition hidden_names g!context) + (list.zip/2 hidden_names + (list\map (get@ #mutual) functions))) + context_types (list\map (function (_ mutual) + (` (-> (~ g!context) (~ (get@ [#mutual #type] mutual))))) + functions) + user_names (list\map (|>> (get@ [#mutual #declaration #declaration.name]) code.local_identifier) + functions)] + g!pop (..push_all (list\map (function (_ [g!name mutual]) + [[here_name (get@ [#mutual #declaration #declaration.name] mutual)] + (..macro g!context g!name)]) + (list.zip/2 hidden_names + functions)))] + (wrap (list& (` (.def: (~ g!context) + [(~+ (list\map (get@ [#mutual #type]) functions))] + (.let [(~ g!context) (: (Rec (~ g!context) + [(~+ context_types)]) + [(~+ definitions)]) + [(~+ user_names)] (~ g!context)] + [(~+ (list\map (function (_ g!name) + (` ((~ g!name) (~ g!context)))) + user_names))]))) + g!pop + (list\map (function (_ mutual) + (.let [g!name (|> mutual (get@ [#mutual #declaration #declaration.name]) code.local_identifier)] + (` (.def: + (~+ (export.format (get@ #exported? mutual))) + (~ g!name) + (~ (get@ [#mutual #type] mutual)) + (.let [[(~+ user_names)] (~ g!context)] + (~ g!name)))))) + functions))))))) diff --git a/stdlib/source/lux/macro/template.lux b/stdlib/source/lux/macro/template.lux index a76b1d989..d51af1d5c 100644 --- a/stdlib/source/lux/macro/template.lux +++ b/stdlib/source/lux/macro/template.lux @@ -170,7 +170,7 @@ #.None (#try.Success (update@ #.definitions (plist.put definition - (#.Definition [false .Macro (' []) (..macro local)])) + (#.Definition [false .Macro (' {}) (..macro local)])) module)) (#.Some _) diff --git a/stdlib/source/lux/meta.lux b/stdlib/source/lux/meta.lux index 454d33498..d7788bd13 100644 --- a/stdlib/source/lux/meta.lux +++ b/stdlib/source/lux/meta.lux @@ -158,7 +158,7 @@ (case name ["" name] (do ..monad - [module_name current_module_name] + [module_name ..current_module_name] (wrap [module_name name])) _ diff --git a/stdlib/source/lux/target.lux b/stdlib/source/lux/target.lux index a5188a907..572c95c90 100644 --- a/stdlib/source/lux/target.lux +++ b/stdlib/source/lux/target.lux @@ -1,11 +1,13 @@ (.module: lux) -(type: #export Host +(type: #export Target Text) (template [<name> <value>] - [(def: #export <name> Host <value>)] + [(def: #export <name> + Target + <value>)] ## TODO: Delete ASAP [old "{old}"] diff --git a/stdlib/source/lux/world/output/video/resolution.lux b/stdlib/source/lux/world/output/video/resolution.lux index 01a7e4c3a..2dbe1c8bc 100644 --- a/stdlib/source/lux/world/output/video/resolution.lux +++ b/stdlib/source/lux/world/output/video/resolution.lux @@ -1,10 +1,26 @@ (.module: - [lux #*]) + [lux #* + [abstract + [equivalence (#+ Equivalence)] + [hash (#+ Hash)]] + [data + ["." product]] + [math + [number + ["." nat]]]]) (type: #export Resolution {#width Nat #height Nat}) +(def: #export hash + (Hash Resolution) + (product.hash nat.hash nat.hash)) + +(def: #export equivalence + (Equivalence Resolution) + (\ ..hash &equivalence)) + ## https://en.wikipedia.org/wiki/Display_resolution#Common_display_resolutions (template [<name> <width> <height>] [(def: #export <name> @@ -16,9 +32,9 @@ [wsvga 1024 600] [xga 1024 768] [xga+ 1152 864] - [wxga|16:9 1280 720] - [wxga|5:3 1280 768] - [wxga|16:10 1280 800] + [wxga/16:9 1280 720] + [wxga/5:3 1280 768] + [wxga/16:10 1280 800] [sxga 1280 1024] [wxga+ 1440 900] [hd+ 1600 900] diff --git a/stdlib/source/program/aedifex/artifact/time.lux b/stdlib/source/program/aedifex/artifact/time.lux index 59367c37d..b227c3954 100644 --- a/stdlib/source/program/aedifex/artifact/time.lux +++ b/stdlib/source/program/aedifex/artifact/time.lux @@ -5,12 +5,15 @@ [equivalence (#+ Equivalence)] [monad (#+ do)]] [control + ["." try (#+ Try)] ["<>" parser ["<.>" text (#+ Parser)]]] [data ["." product] [text - ["%" format (#+ Format)]]]] + ["%" format (#+ Format)]]] + [time + ["." instant (#+ Instant)]]] ["." / #_ ["#." date] ["#." time]]) @@ -22,6 +25,13 @@ Time [/date.epoch time.midnight]) +(def: #export (from_instant instant) + (-> Instant (Try Time)) + (do try.monad + [date (/date.date (instant.date instant))] + (wrap [date + (instant.time instant)]))) + (def: #export equivalence (Equivalence Time) (product.equivalence /date.equivalence diff --git a/stdlib/source/program/aedifex/metadata/snapshot.lux b/stdlib/source/program/aedifex/metadata/snapshot.lux index f6878a023..c8feaa3d9 100644 --- a/stdlib/source/program/aedifex/metadata/snapshot.lux +++ b/stdlib/source/program/aedifex/metadata/snapshot.lux @@ -37,6 +37,7 @@ ["/#" // #_ [repository (#+ Repository)] ["#." artifact (#+ Group Name Version Artifact) + ["#/." time] ["#/." type (#+ Type)] ["#/." versioning (#+ Versioning)] ["#/." snapshot @@ -99,7 +100,7 @@ (|>> (case> (^ (list)) (list {#///artifact/snapshot/version.extension ///artifact/type.jvm_library #///artifact/snapshot/version.value version - #///artifact/snapshot/version.updated instant.epoch}) + #///artifact/snapshot/version.updated ///artifact/time.epoch}) versions versions)))) diff --git a/stdlib/source/program/aedifex/repository/local.lux b/stdlib/source/program/aedifex/repository/local.lux index 6b4575627..d026559c9 100644 --- a/stdlib/source/program/aedifex/repository/local.lux +++ b/stdlib/source/program/aedifex/repository/local.lux @@ -36,13 +36,11 @@ Bit URI (Promise (Try (File Promise)))) - (do {! promise.monad} - [#let [uri (text.replace_once ///metadata.remote_file ///metadata.local_file uri)] - home (\ program home []) - #let [/ (\ system separator) - absolute_path (format home / (..root /) / (..path / uri))]] + (let [uri (text.replace_once ///metadata.remote_file ///metadata.local_file uri) + / (\ system separator) + absolute_path (format (..root /) / (..path / uri))] (if create? - (do {! (try.with !)} + (do {! (try.with promise.monad)} [_ (: (Promise (Try Path)) (file.make_directories promise.monad system (file.parent system absolute_path)))] (: (Promise (Try (File Promise))) diff --git a/stdlib/source/program/licentia.lux b/stdlib/source/program/licentia.lux deleted file mode 100644 index 896f74dab..000000000 --- a/stdlib/source/program/licentia.lux +++ /dev/null @@ -1,82 +0,0 @@ -## 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 #* - [host (#+ import:)] - [abstract - [monad (#+ do)]] - [control - [remember (#+ to-do)] - ["." io (#+ IO) ("#\." monad)] - ["." try (#+ Try)] - ["." parser - ["." cli (#+ program:)] - ["<.>" json]] - [security - ["!" capability]]] - [data - ["." maybe] - ["." text - ["%" format (#+ format)] - ["." encoding]] - [format - ["." json]]] - [world - ["." file (#+ Path File)]]] - ["." / #_ - ["#." input] - ["#." output]]) - -(with-expansions [<expiry> "2021-04-01"] - (to-do <expiry> "Replace _.work with _.covered-work or _.licensed-work") - (to-do <expiry> "Create a short notice to add as a comment to each file in the _.work")) - -(import: java/lang/String - ["#::." - (trim [] java/lang/String)]) - -(def: default-output-file "LICENSE") - -(def: (success-message output) - (-> Path 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 - [?done (: (IO (Try Any)) - (do (try.with io.monad) - [file (!.use (\ file.default file) [input]) - blob (!.use (\ file content) []) - document (io\wrap (do {! try.monad} - [raw-json (\ encoding.utf8 decode blob) - json (|> raw-json - (:coerce java/lang/String) - java/lang/String::trim - (:coerce Text) - (\ json.codec decode))] - (|> json - (<json>.run /input.license) - (\ ! map /output.license)))) - output-file (: (IO (Try (File IO))) - (file.get-file io.monad file.default output))] - (!.use (\ output-file over-write) (\ encoding.utf8 encode document))))] - (wrap (log! (case ?done - (#try.Success _) - (success-message output) - - (#try.Failure message) - message))))) diff --git a/stdlib/source/program/licentia/document.lux b/stdlib/source/program/licentia/document.lux deleted file mode 100644 index b1bc20cce..000000000 --- a/stdlib/source/program/licentia/document.lux +++ /dev/null @@ -1,47 +0,0 @@ -(.module: - [lux (#- or and) - [data - ["." text - ["%" format (#+ format)]] - [collection - ["." 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))) - -(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 deleted file mode 100644 index 5ec07e32b..000000000 --- a/stdlib/source/program/licentia/input.lux +++ /dev/null @@ -1,166 +0,0 @@ -(.module: - [lux #* - [abstract - [monad (#+ do)]] - [control - ["." exception (#+ exception:)] - ["<>" parser - ["<.>" json (#+ Parser)]]] - [data - [text - ["%" format (#+ format)]] - [number - ["n" nat] - ["i" int] - ["f" frac]]]] - ["." // #_ - ["#" license (#+ Identification - Termination - Liability - Distribution - Commercial - Extension - Entity Black-List - URL Attribution - Addendum - License) - ["." time (#+ Period)] - ["." copyright]]]) - -(def: identification - (Parser Identification) - (<json>.object - ($_ <>.and - (<json>.field "name" <json>.string) - (<json>.field "version" <json>.string)))) - -(exception: #export (cannot-use-fractional-amount {amount Frac}) - (exception.report - ["Amount" (%.frac amount)])) - -(exception: #export (cannot-use-negative-amount {amount Int}) - (exception.report - ["Amount" (%.int amount)])) - -(def: amount - (Parser Nat) - (do <>.monad - [amountF <json>.number - #let [amountI (f.int amountF)] - _ (<>.assert (exception.construct cannot-use-fractional-amount amountF) - (f.= amountF - (i.frac amountI))) - _ (<>.assert (exception.construct cannot-use-negative-amount amountI) - (i.> +0 amountI))] - (wrap (.nat amountI)))) - -(exception: #export (invalid-period {period (Period Nat)}) - (exception.report - ["Start" (%.nat (get@ #time.start period))] - ["End" (%.nat (get@ #time.end period))])) - -(def: period - (Parser (Period Nat)) - (<json>.object - (do <>.monad - [start (<json>.field "start" ..amount) - end (<json>.field "end" ..amount) - #let [period {#time.start start - #time.end end}] - _ (<>.assert (exception.construct invalid-period period) - (n.<= end start))] - (wrap period)))) - -(def: copyright-holder - (Parser copyright.Holder) - (<json>.object - ($_ <>.and - (<json>.field "name" <json>.string) - (<json>.field "period" ..period)))) - -(def: termination - (Parser Termination) - (<json>.object - ($_ <>.and - (<json>.field "patent retaliation?" <json>.boolean) - (<json>.field "termination period" ..amount) - (<json>.field "grace period" ..amount)))) - -(def: liability - (Parser Liability) - (<json>.object - ($_ <>.and - (<json>.field "can accept?" <json>.boolean) - (<json>.field "disclaim high risk?" <json>.boolean)))) - -(def: distribution - (Parser Distribution) - (<json>.object - ($_ <>.and - (<json>.field "can re-license?" <json>.boolean) - (<json>.field "can multi-license?" <json>.boolean)))) - -(def: commercial - (Parser Commercial) - (<json>.object - ($_ <>.and - (<json>.field "can sell?" <json>.boolean) - (<json>.field "require contributor credit?" <json>.boolean) - (<json>.field "allow contributor endorsement?" <json>.boolean)))) - -(def: extension - (Parser Extension) - (<json>.object - ($_ <>.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 - (Parser Entity) - <json>.string) - -(def: black-list - (Parser Black-List) - (<json>.object - ($_ <>.and - (<json>.field "justification" (<json>.nullable <json>.string)) - (<json>.field "entities" (<json>.array (<>.many ..entity)))))) - -(def: url - (Parser URL) - <json>.string) - -(def: attribution - (Parser Attribution) - (<json>.object - ($_ <>.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: addendum - (Parser Addendum) - (<json>.object - ($_ <>.and - (<json>.field "commons clause?" <json>.boolean) - ))) - -(def: #export license - (Parser License) - (<json>.object - ($_ <>.and - (<json>.field "copyright-holders" (<json>.array (<>.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 (<>.some ..black-list))) - (<json>.field "attribution" (<json>.nullable ..attribution)) - (<>.default {#//.commons-clause? false} - (<json>.field "addendum" ..addendum)) - ))) diff --git a/stdlib/source/program/licentia/license.lux b/stdlib/source/program/licentia/license.lux deleted file mode 100644 index c62c8419d..000000000 --- a/stdlib/source/program/licentia/license.lux +++ /dev/null @@ -1,62 +0,0 @@ -(.module: - [lux #*] - ["." / #_ - [time (#+ Days Months Period)] - ["#." copyright]]) - -(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 Addendum - {#commons-clause? Bit}) - -(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) - #addendum Addendum}) diff --git a/stdlib/source/program/licentia/license/addendum.lux b/stdlib/source/program/licentia/license/addendum.lux deleted file mode 100644 index 7e467c630..000000000 --- a/stdlib/source/program/licentia/license/addendum.lux +++ /dev/null @@ -1,28 +0,0 @@ -(.module: - [lux #* - [data - [text - ["%" format (#+ format)]]]] - ["." // (#+ Addendum) - [// - ["$" document]]]) - -## https://commonsclause.com/ -(def: #export commons-clause - Text - (format ($.block "The Software is provided to you by the Licensor under the License, as defined below, subject to the following condition.") - ($.block "Without limiting other conditions in the License, the grant of rights under the License will not include, and the License does not grant to you, the right to Sell the Software.") - ($.block "For purposes of the foregoing, “Sell” means practicing any or all of the rights granted to you under the License to provide to third parties, for a fee or other consideration (including without limitation fees for hosting or consulting/ support services related to the Software), a product or service whose value derives, entirely or substantially, from the functionality of the Software. Any license notice or attribution required by the License must also include this Commons Clause License Condition notice."))) - -(def: #export (output value) - (-> Addendum Text) - (`` (format (~~ (template [<title> <condition> <content>] - [(if <condition> - ($.block ($.section {#$.title <title> - #$.content <content>})) - "")] - - ["“Commons Clause” License Condition v1.0" - (get@ #//.commons-clause? value) - ..commons-clause] - ))))) diff --git a/stdlib/source/program/licentia/license/assurance.lux b/stdlib/source/program/licentia/license/assurance.lux deleted file mode 100644 index 155472cd1..000000000 --- a/stdlib/source/program/licentia/license/assurance.lux +++ /dev/null @@ -1,25 +0,0 @@ -(.module: - [lux #* - [data - ["." text - ["%" format (#+ 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 deleted file mode 100644 index 14dcdfe91..000000000 --- a/stdlib/source/program/licentia/license/black-list.lux +++ /dev/null @@ -1,31 +0,0 @@ -(.module: - [lux #* - [data - ["." maybe ("#\." functor)] - ["." text - ["%" format (#+ format)]] - [collection - ["." list ("#\." functor)]]]] - ["." // (#+ Entity Black-List) - ["_" term] - [// - ["$" document]]]) - -(def: #export entity - (-> Entity Text) - %.text) - -(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 deleted file mode 100644 index e044baa43..000000000 --- a/stdlib/source/program/licentia/license/commercial.lux +++ /dev/null @@ -1,30 +0,0 @@ -(.module: - [lux #* - [data - ["." text - ["%" format (#+ format)]]]] - ["." // (#+ Commercial) - ["_" term] - [// - ["$" document]]]) - -(def: #export cannot-sell - (let [preamble (format "Without limiting other conditions in " _.license) - direct-condition (format "the grant of rights under " _.license - " will not include, and does not grant to " _.recipient - ", the right to " _.sell " " _.work) - derivative-condition (format "or any " _.derivative-work)] - ($.sentence (format preamble - ", " direct-condition - ", " derivative-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 deleted file mode 100644 index 872af9d2b..000000000 --- a/stdlib/source/program/licentia/license/copyright.lux +++ /dev/null @@ -1,8 +0,0 @@ -(.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 deleted file mode 100644 index 6739039dc..000000000 --- a/stdlib/source/program/licentia/license/definition.lux +++ /dev/null @@ -1,240 +0,0 @@ -(.module: - [lux (#- Definition) - [data - ["." text - ["%" format (#+ 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") - -(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 deleted file mode 100644 index f911623a0..000000000 --- a/stdlib/source/program/licentia/license/distribution.lux +++ /dev/null @@ -1,112 +0,0 @@ -(.module: - [lux #* - [data - ["." text - ["%" format (#+ format)]] - [collection - ["." 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 deleted file mode 100644 index f808a8913..000000000 --- a/stdlib/source/program/licentia/license/extension.lux +++ /dev/null @@ -1,166 +0,0 @@ -(.module: - [lux #* - [data - ["." text - ["%" format (#+ format)]]]] - ["." // (#+ 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 " (%.nat 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 " (%.nat 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 " (%.nat 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 deleted file mode 100644 index 0f45f3592..000000000 --- a/stdlib/source/program/licentia/license/grant.lux +++ /dev/null @@ -1,128 +0,0 @@ -(.module: - [lux #* - [data - ["." text - ["%" format (#+ 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 " (%.nat 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 " (%.nat 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 deleted file mode 100644 index 51b98ad40..000000000 --- a/stdlib/source/program/licentia/license/liability.lux +++ /dev/null @@ -1,160 +0,0 @@ -(.module: - [lux #* - [data - ["." text - ["%" format (#+ 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 deleted file mode 100644 index 1617d9909..000000000 --- a/stdlib/source/program/licentia/license/limitation.lux +++ /dev/null @@ -1,75 +0,0 @@ -(.module: - [lux #* - [data - ["." text - ["%" format (#+ 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 deleted file mode 100644 index 03adb1462..000000000 --- a/stdlib/source/program/licentia/license/miscellaneous.lux +++ /dev/null @@ -1,106 +0,0 @@ -(.module: - [lux #* - [data - ["." text - ["%" format (#+ 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 deleted file mode 100644 index 219af97f4..000000000 --- a/stdlib/source/program/licentia/license/notice.lux +++ /dev/null @@ -1,32 +0,0 @@ -(.module: - [lux #* - [data - [number - ["n" nat]] - ["." text - ["%" format (#+ format)]] - [collection - ["." 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? - (%.nat start) - (format (%.nat start) "-" (%.nat 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 deleted file mode 100644 index 855141690..000000000 --- a/stdlib/source/program/licentia/license/submission.lux +++ /dev/null @@ -1,26 +0,0 @@ -(.module: - [lux #* - [data - ["." text - ["%" format (#+ 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 deleted file mode 100644 index 54b3b1cc4..000000000 --- a/stdlib/source/program/licentia/license/term.lux +++ /dev/null @@ -1,34 +0,0 @@ -(.module: - [lux (#- Definition)] - ["." // #_ - ["#." definition]]) - -(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 deleted file mode 100644 index 22f28f607..000000000 --- a/stdlib/source/program/licentia/license/time.lux +++ /dev/null @@ -1,15 +0,0 @@ -(.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 deleted file mode 100644 index fdbd9accd..000000000 --- a/stdlib/source/program/licentia/output.lux +++ /dev/null @@ -1,309 +0,0 @@ -(.module: - [lux (#- Definition) - [data - ["." maybe ("#\." functor)] - ["." text - ["%" format (#+ format)]] - [collection - ["." 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] - ["." addendum]] - ["$" 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 (~~ (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 (~~ (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 (~~ (template [<title> <content>] - [($.block ($.section {#$.title <title> - #$.content <content>}))] - - ["Representation" - assurance.representation] - - ["Fair Use" - assurance.fair-use]))))) - -(def: #export (liability value) - (-> Liability Text) - (`` (format (~~ (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 (~~ (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 (~~ (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 (~~ (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 (~~ (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?) - - (addendum.output (get@ #license.addendum value)) - - notice.end-of-license - )))) diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index 3833c0828..ae9bde67c 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -1,66 +1,49 @@ (.module: [lux #* + [program (#+ program:)] ["_" test (#+ Test)] [control - [io (#+ io)] - [parser - [cli (#+ program:)]]]] + [io (#+ io)]]] ["." / #_ ["#." artifact] - ["#." input] - ["#." command #_ - ["#/." version] - ["#/." clean] - ["#/." pom] - ["#/." install] - ["#/." deploy] - ["#/." deps] - ["#/." build] - ["#/." test] - ["#/." auto]] - ["#." local] - ["#." dependency - ["#/." resolution] - ["#/." status]] - ["#." package] - ["#." profile] - ["#." project] ["#." cli] - ["#." hash] - ["#." parser] - ["#." pom] - ["#." repository] - ["#." runtime] - ["#." metadata]]) + ["#." command] + ## ["#." input] + ## ["#." local] + ## ["#." dependency + ## ## ["#/." resolution] + ## ["#/." status]] + ## ["#." package] + ## ["#." profile] + ## ["#." project] + ## ["#." hash] + ## ["#." parser] + ## ["#." pom] + ## ["#." repository] + ## ["#." runtime] + ## ["#." metadata] + ]) (def: test Test ($_ _.and /artifact.test - /input.test - /command/version.test - /command/clean.test - /command/pom.test - /command/install.test - /command/deploy.test - /command/deps.test - /command/build.test - /command/test.test - /command/auto.test - /local.test - /dependency.test - /dependency/resolution.test - /dependency/status.test - /package.test - /profile.test - /project.test /cli.test - /hash.test - /parser.test - /pom.test - /repository.test - /runtime.test - /metadata.test + /command.test + ## /input.test + ## /local.test + ## /dependency.test + ## ## /dependency/resolution.test + ## /dependency/status.test + ## /package.test + ## /profile.test + ## /project.test + ## /hash.test + ## /parser.test + ## /pom.test + ## /repository.test + ## /runtime.test + ## /metadata.test )) (program: args diff --git a/stdlib/source/test/aedifex/command.lux b/stdlib/source/test/aedifex/command.lux new file mode 100644 index 000000000..0ef18f044 --- /dev/null +++ b/stdlib/source/test/aedifex/command.lux @@ -0,0 +1,32 @@ +(.module: + [lux #* + ["_" test (#+ Test)]] + ["." / #_ + ["#." clean] + ["#." install] + ["#." pom] + ["#." version]] + {#program + ["." / + ## ["#." deploy] + ## ["#." deps] + ## ["#." build] + ## ["#." test] + ## ["#." auto] + ]}) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [/.Command]) + ($_ _.and + /clean.test + /install.test + /pom.test + /version.test + ## /deploy.test + ## /deps.test + ## /build.test + ## /test.test + ## /auto.test + ))) diff --git a/stdlib/source/test/aedifex/command/install.lux b/stdlib/source/test/aedifex/command/install.lux index ce3f21de8..33ee7192d 100644 --- a/stdlib/source/test/aedifex/command/install.lux +++ b/stdlib/source/test/aedifex/command/install.lux @@ -16,8 +16,7 @@ ["." maybe] ["." binary] ["." text ("#\." equivalence) - ["%" format (#+ format)] - ["." encoding]] + ["%" format (#+ format)]] [format ["." xml]] [collection @@ -67,13 +66,11 @@ (def: (execute! program fs sample) (-> (Program Promise) (file.System Promise) ///.Profile (Promise (Try Text))) - (do promise.monad - [home (\ program home [])] - (do ///action.monad - [#let [console (@version.echo "")] - _ (..make_sources! fs (get@ #///.sources sample)) - _ (/.do! console fs (///repository/local.repository program fs) sample)] - (!.use (\ console read_line) [])))) + (do ///action.monad + [#let [console (@version.echo "")] + _ (..make_sources! fs (get@ #///.sources sample)) + _ (/.do! console fs (///repository/local.repository program fs) sample)] + (!.use (\ console read_line) []))) (def: #export test Test @@ -91,17 +88,18 @@ verdict (do ///action.monad [logging (..execute! program fs sample) #let [/ uri.separator - artifact_path (format (///local.uri identity) / (///artifact.identity identity)) + artifact_path (///local.uri (get@ #///artifact.version identity) identity) library_path (format artifact_path ///artifact/extension.lux_library) pom_path (format artifact_path ///artifact/extension.pom)] + #let [succeeded! (text\= //clean.success logging)] library_exists! (\ promise.monad map exception.return (file.file_exists? promise.monad fs library_path)) pom_exists! (\ promise.monad map exception.return (file.file_exists? promise.monad fs pom_path))] - (wrap (and (text\= //clean.success logging) + (wrap (and succeeded! library_exists! pom_exists!)))] (_.cover' [/.do!] diff --git a/stdlib/source/test/aedifex/command/pom.lux b/stdlib/source/test/aedifex/command/pom.lux index 33c102926..c368d5f84 100644 --- a/stdlib/source/test/aedifex/command/pom.lux +++ b/stdlib/source/test/aedifex/command/pom.lux @@ -12,7 +12,8 @@ [data ["." binary] ["." text ("#\." equivalence) - ["." encoding]] + [encoding + ["." utf8]]] [format ["." xml]]] [math @@ -46,7 +47,7 @@ (do ! [verdict (do ///action.monad [expected (|> (///pom.write sample) - (try\map (|>> (\ xml.codec encode) (\ encoding.utf8 encode))) + (try\map (|>> (\ xml.codec encode) (\ utf8.codec encode))) (\ ! wrap)) file (: (Promise (Try (File Promise))) (file.get_file promise.monad fs path)) diff --git a/stdlib/source/test/aedifex/command/version.lux b/stdlib/source/test/aedifex/command/version.lux index ee26b3b5d..c7a9aa4ef 100644 --- a/stdlib/source/test/aedifex/command/version.lux +++ b/stdlib/source/test/aedifex/command/version.lux @@ -60,7 +60,9 @@ (def: #export echo (-> Text (Console Promise)) - (|>> [true] (console.mock ..simulation))) + (|>> [true] + (console.mock ..simulation) + console.async)) (def: #export test Test diff --git a/stdlib/source/test/licentia.lux b/stdlib/source/test/licentia.lux deleted file mode 100644 index af03062cb..000000000 --- a/stdlib/source/test/licentia.lux +++ /dev/null @@ -1,369 +0,0 @@ -(.module: - [lux #* - ["_" test (#+ Test)] - [abstract - [monad (#+ do)]] - [control - [io (#+ io)] - [parser - [cli (#+ program:)]]] - [data - ["." bit ("#\." equivalence)] - ["." maybe ("#\." functor)] - ["." text] - [number - ["n" nat ("#\." interval)]] - [collection - ["." list ("#\." functor)]]] - [math - ["." random (#+ Random)]]] - {#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)))) diff --git a/stdlib/source/test/lux/control/function.lux b/stdlib/source/test/lux/control/function.lux index f816075f5..354433cc8 100644 --- a/stdlib/source/test/lux/control/function.lux +++ b/stdlib/source/test/lux/control/function.lux @@ -18,7 +18,8 @@ ["." / #_ ["#." contract] ["#." memo] - ["#." mixin]]) + ["#." mixin] + ["#." mutual]]) (def: #export test Test @@ -62,4 +63,5 @@ /contract.test /memo.test /mixin.test + /mutual.test )))) diff --git a/stdlib/source/test/lux/control/function/mutual.lux b/stdlib/source/test/lux/control/function/mutual.lux new file mode 100644 index 000000000..e645e282b --- /dev/null +++ b/stdlib/source/test/lux/control/function/mutual.lux @@ -0,0 +1,65 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [data + ["." bit ("#\." equivalence)] + [text + ["%" format (#+ format)]]] + [math + ["." random (#+ Random)] + [number + ["n" nat]]]] + {1 + ["." /]}) + +(def: test_let + Test + (do {! random.monad} + [sample (\ ! map (n.% 10) random.nat) + #let [expected (n.even? sample)]] + (<| (_.cover [/.let]) + (/.let [(even? number) + (-> Nat Bit) + (case number + 0 true + _ (odd? (dec number))) + + (odd? number) + (-> Nat Bit) + (case number + 0 false + _ (even? (dec number)))] + (and (bit\= expected (even? sample)) + (bit\= (not expected) (odd? sample))))))) + +(/.def: + [(even? number) + (-> Nat Bit) + (case number + 0 true + _ (odd? (dec number)))] + + [(odd? number) + (-> Nat Bit) + (case number + 0 false + _ (even? (dec number)))]) + +(def: test_def + Test + (do {! random.monad} + [sample (\ ! map (n.% 10) random.nat) + #let [expected (n.even? sample)]] + (<| (_.cover [/.def:]) + (and (bit\= expected (..even? sample)) + (bit\= (not expected) (..odd? sample)))))) + +(def: #export test + Test + (<| (_.covering /._) + ($_ _.and + ..test_let + ..test_def + ))) diff --git a/stdlib/source/test/lux/world.lux b/stdlib/source/test/lux/world.lux index 0405ef7ee..8b560ca40 100644 --- a/stdlib/source/test/lux/world.lux +++ b/stdlib/source/test/lux/world.lux @@ -5,7 +5,10 @@ ["#." file] ["#." shell] ["#." console] - ["#." program]]) + ["#." program] + ["#." output #_ + ["#/." video #_ + ["#/." resolution]]]]) (def: #export test Test @@ -14,4 +17,5 @@ /shell.test /console.test /program.test + /output/video/resolution.test )) diff --git a/stdlib/source/test/lux/world/output/video/resolution.lux b/stdlib/source/test/lux/world/output/video/resolution.lux new file mode 100644 index 000000000..f5dcf5380 --- /dev/null +++ b/stdlib/source/test/lux/world/output/video/resolution.lux @@ -0,0 +1,63 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence] + ["$." hash]]}] + [data + ["." maybe] + [collection + ["." list] + ["." set (#+ Set)]]] + [math + ["." random (#+ Random)] + [number + ["n" nat]]]] + {1 + ["." /]}) + +(with_expansions [<resolutions> (as_is /.svga + /.wsvga + /.xga + /.xga+ + /.wxga/16:9 + /.wxga/5:3 + /.wxga/16:10 + /.sxga + /.wxga+ + /.hd+ + /.wsxga+ + /.fhd + /.wuxga + /.wqhd + /.uhd-4k)] + (def: catalogue + (Set /.Resolution) + (set.from_list /.hash (list <resolutions>))) + + (def: #export random + (Random /.Resolution) + (let [listing (set.to_list catalogue) + count (list.size listing)] + (do {! random.monad} + [choice (\ ! map (n.% count) random.nat)] + (wrap (maybe.assume (list.nth choice listing)))))) + + (def: #export test + Test + (<| (_.covering /._) + (_.for [/.Resolution]) + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.hash] + ($hash.spec /.hash ..random)) + + (_.cover [<resolutions>] + (let [listing (set.to_list catalogue)] + (n.= (list.size listing) + (set.size catalogue)))) + )))) |