Added support for "Commons Clause" to Licentia.

5 files changed, 86 insertions, 45 deletions

diff --git a/stdlib/source/program/licentia.lux b/stdlib/source/program/licentia.lux
index e95c261a9..032269af3 100644
--- a/stdlib/source/program/licentia.lux
+++ b/stdlib/source/program/licentia.lux
@@ -13,12 +13,16 @@
 
 (.module:
   [lux #*
+   [host (#+ import:)]
    [abstract
     [monad (#+ do)]]
    [control
     [remember (#+ to-do)]
+    ["." io (#+ IO) ("#\." monad)]
     ["." try (#+ Try)]
-    ["." parser]
+    ["." parser
+     ["." cli (#+ program:)]
+     ["<.>" json]]
     [security
      ["!" capability]]]
    [data
@@ -28,21 +32,19 @@
      ["." encoding]]
     [format
      ["." json]]]
-   ["." cli (#+ program:)]
-   ["." io (#+ IO) ("#\." monad)]
    [world
-    ["." file (#+ Path File)]]
-   [host (#+ import:)]]
+    ["." file (#+ Path File)]]]
   ["." / #_
    ["#." input]
    ["#." output]])
 
-(with-expansions [<expiry> "2019-04-01"]
+(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))
+  ["#::."
+   (trim [] java/lang/String)])
 
 (def: default-output-file "LICENSE")
 
@@ -57,23 +59,24 @@
   (do io.monad
     [?done (: (IO (Try Any))
               (do (try.with io.monad)
-                [file (!.use (\ file.default file) input)
+                [file (!.use (\ file.default file) [input])
                  blob (!.use (\ file content) [])
-                 document (io\wrap (do try.monad
+                 document (io\wrap (do {! try.monad}
                                      [raw-json (encoding.from-utf8 blob)
                                       json (|> raw-json
                                                (:coerce java/lang/String)
                                                java/lang/String::trim
                                                (:coerce Text)
-                                               (\ json.codec decode))
-                                      license (json.run json /input.license)]
-                                     (wrap (/output.license license))))
+                                               (\ 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.to-utf8 document))))]
-    (case ?done
-      (#try.Success _)
-      (wrap (log! (success-message output)))
+    (wrap (log! (case ?done
+                  (#try.Success _)
+                  (success-message output)
 
-      (#try.Failure message)
-      (wrap (log! message)))))
+                  (#try.Failure message)
+                  message)))))
diff --git a/stdlib/source/program/licentia/input.lux b/stdlib/source/program/licentia/input.lux
index 7d2192fe1..48617f045 100644
--- a/stdlib/source/program/licentia/input.lux
+++ b/stdlib/source/program/licentia/input.lux
@@ -1,14 +1,14 @@
 (.module:
   [lux #*
+   [abstract
+    [monad (#+ do)]]
    [control
-    [monad (#+ do)]
-    ["ex" exception (#+ exception:)]
-    ["." parser]]
+    ["." exception (#+ exception:)]
+    ["." parser
+     ["." json (#+ Parser)]]]
    [data
     [text
      ["%" format (#+ format)]]
-    [format
-     ["." json (#+ Reader)]]
     [number
      ["n" nat]
      ["i" int]
@@ -27,55 +27,58 @@
     ["." copyright]]])
 
 (def: identification
-  (Reader Identification)
+  (Parser Identification)
   (json.object
     ($_ parser.and
         (json.field "name" json.string)
         (json.field "version" json.string))))
 
 (exception: #export (cannot-use-fractional-amount {amount Frac})
-  (ex.report ["Amount" (%.frac amount)]))
+  (exception.report
+   ["Amount" (%.frac amount)]))
 
 (exception: #export (cannot-use-negative-amount {amount Int})
-  (ex.report ["Amount" (%.int amount)]))
+  (exception.report
+   ["Amount" (%.int amount)]))
 
 (def: amount
-  (Reader Nat)
+  (Parser Nat)
   (do parser.monad
     [amountF json.number
      #let [amountI (f.int amountF)]
-     _ (parser.assert (ex.construct cannot-use-fractional-amount amountF)
+     _ (parser.assert (exception.construct cannot-use-fractional-amount amountF)
                       (f.= amountF
                            (i.frac amountI)))
-     _ (parser.assert (ex.construct cannot-use-negative-amount amountI)
+     _ (parser.assert (exception.construct cannot-use-negative-amount amountI)
                       (i.> +0 amountI))]
     (wrap (.nat amountI))))
 
 (exception: #export (invalid-period {period (Period Nat)})
-  (ex.report ["Start" (%.nat (get@ #time.start period))]
-             ["End" (%.nat (get@ #time.end period))]))
+  (exception.report
+   ["Start" (%.nat (get@ #time.start period))]
+   ["End" (%.nat (get@ #time.end period))]))
 
 (def: period
-  (Reader (Period Nat))
+  (Parser (Period Nat))
   (json.object
     (do parser.monad
       [start (json.field "start" ..amount)
        end (json.field "end" ..amount)
        #let [period {#time.start start
                      #time.end end}]
-       _ (parser.assert (ex.construct invalid-period period)
+       _ (parser.assert (exception.construct invalid-period period)
                         (n.<= end start))]
       (wrap period))))
 
 (def: copyright-holder
-  (Reader copyright.Holder)
+  (Parser copyright.Holder)
   (json.object
     ($_ parser.and
         (json.field "name" json.string)
         (json.field "period" ..period))))
 
 (def: termination
-  (Reader Termination)
+  (Parser Termination)
   (json.object
     ($_ parser.and
         (json.field "patent retaliation?" json.boolean)
@@ -83,21 +86,21 @@
         (json.field "grace period" ..amount))))
 
 (def: liability
-  (Reader Liability)
+  (Parser Liability)
   (json.object
     ($_ parser.and
         (json.field "can accept?" json.boolean)
         (json.field "disclaim high risk?" json.boolean))))
 
 (def: distribution
-  (Reader Distribution)
+  (Parser Distribution)
   (json.object
     ($_ parser.and
         (json.field "can re-license?" json.boolean)
         (json.field "can multi-license?" json.boolean))))
 
 (def: commercial
-  (Reader Commercial)
+  (Parser Commercial)
   (json.object
     ($_ parser.and
         (json.field "can sell?" json.boolean)
@@ -105,7 +108,7 @@
         (json.field "allow contributor endorsement?" json.boolean))))
 
 (def: extension
-  (Reader Extension)
+  (Parser Extension)
   (json.object
     ($_ parser.and
         (json.field "same license?" json.boolean)
@@ -114,22 +117,22 @@
         (json.field "must describe modifications?" json.boolean))))
 
 (def: entity
-  (Reader Entity)
+  (Parser Entity)
   json.string)
 
 (def: black-list
-  (Reader Black-List)
+  (Parser Black-List)
   (json.object
     ($_ parser.and
         (json.field "justification" (json.nullable json.string))
         (json.field "entities" (json.array (parser.many ..entity))))))
 
 (def: url
-  (Reader URL)
+  (Parser URL)
   json.string)
 
 (def: attribution
-  (Reader Attribution)
+  (Parser Attribution)
   (json.object
     ($_ parser.and
         (json.field "copyright-notice" json.string)
@@ -138,7 +141,7 @@
         (json.field "image" (json.nullable ..url)))))
 
 (def: #export license
-  (Reader License)
+  (Parser License)
   (json.object
     ($_ parser.and
         (json.field "copyright-holders" (json.array (parser.many ..copyright-holder)))
diff --git a/stdlib/source/program/licentia/license.lux b/stdlib/source/program/licentia/license.lux
index 375ed8c12..c62c8419d 100644
--- a/stdlib/source/program/licentia/license.lux
+++ b/stdlib/source/program/licentia/license.lux
@@ -46,6 +46,9 @@
    #url URL
    #image (Maybe URL)})
 
+(type: #export Addendum
+  {#commons-clause? Bit})
+
 (type: #export License
   {#copyright-holders (List /copyright.Holder)
    #identification (Maybe Identification)
@@ -55,4 +58,5 @@
    #commercial Commercial
    #extension Extension
    #black-lists (List Black-List)
-   #attribution (Maybe Attribution)})
+   #attribution (Maybe Attribution)
+   #addendum Addendum})
diff --git a/stdlib/source/program/licentia/license/addendum.lux b/stdlib/source/program/licentia/license/addendum.lux
new file mode 100644
index 000000000..7e467c630
--- /dev/null
+++ b/stdlib/source/program/licentia/license/addendum.lux
@@ -0,0 +1,28 @@
+(.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/output.lux b/stdlib/source/program/licentia/output.lux
index 5d3899170..fdbd9accd 100644
--- a/stdlib/source/program/licentia/output.lux
+++ b/stdlib/source/program/licentia/output.lux
@@ -29,7 +29,8 @@
     ["." miscellaneous]
     ["." black-list]
     ["." notice]
-    ["_" term]]
+    ["_" term]
+    ["." addendum]]
    ["$" document]])
 
 (def: #export (definition value)
@@ -301,6 +302,8 @@
                     (maybe.default ""))
 
                 (..miscellaneous identified?)
+
+                (addendum.output (get@ #license.addendum value))
                 
                 notice.end-of-license
                 ))))