From c03bd9f9787fb9f383c57b4ebb0fa9d49abbfaa1 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 3 Jan 2021 07:48:12 -0400 Subject: Place the "program:" macro of "lux/control/parser/cli" in its own module. --- stdlib/source/program/aedifex.lux | 4 +- .../source/program/aedifex/artifact/time_stamp.lux | 35 ++++ .../program/aedifex/artifact/time_stamp/date.lux | 39 +++++ .../program/aedifex/artifact/time_stamp/time.lux | 35 ++++ stdlib/source/program/aedifex/artifact/value.lux | 53 +++++++ .../source/program/aedifex/artifact/versioning.lux | 176 +++++++++++++++++++++ stdlib/source/program/aedifex/repository/local.lux | 2 +- 7 files changed, 341 insertions(+), 3 deletions(-) create mode 100644 stdlib/source/program/aedifex/artifact/time_stamp.lux create mode 100644 stdlib/source/program/aedifex/artifact/time_stamp/date.lux create mode 100644 stdlib/source/program/aedifex/artifact/time_stamp/time.lux create mode 100644 stdlib/source/program/aedifex/artifact/value.lux create mode 100644 stdlib/source/program/aedifex/artifact/versioning.lux (limited to 'stdlib/source/program') diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux index 52269d053..051bba9b1 100644 --- a/stdlib/source/program/aedifex.lux +++ b/stdlib/source/program/aedifex.lux @@ -1,5 +1,6 @@ (.module: [lux (#- Name) + [program (#+ program:)] [abstract [monad (#+ do)]] [control @@ -8,8 +9,7 @@ ["." try (#+ Try) ("#\." functor)] ["." exception (#+ exception:)] [parser - [environment (#+ Environment)] - [cli (#+ program:)]] + [environment (#+ Environment)]] [security ["!" capability]] [concurrency diff --git a/stdlib/source/program/aedifex/artifact/time_stamp.lux b/stdlib/source/program/aedifex/artifact/time_stamp.lux new file mode 100644 index 000000000..0eab45a14 --- /dev/null +++ b/stdlib/source/program/aedifex/artifact/time_stamp.lux @@ -0,0 +1,35 @@ +(.module: + [lux #* + [abstract + [monad (#+ do)]] + [control + ["<>" parser + ["<.>" text (#+ Parser)]]] + [data + [text + ["%" format]]] + [time + ["." instant (#+ Instant)]]] + ["." / #_ + ["#." date] + ["#." time]]) + +(type: #export Time_Stamp + Instant) + +(def: #export separator + ".") + +(def: #export (format value) + (%.Format Time_Stamp) + (%.format (/date.format (instant.date value)) + ..separator + (/time.format (instant.time value)))) + +(def: #export parser + (Parser Time_Stamp) + (do <>.monad + [date /date.parser + _ (.this ..separator) + time /time.parser] + (wrap (instant.from_date_time date time)))) diff --git a/stdlib/source/program/aedifex/artifact/time_stamp/date.lux b/stdlib/source/program/aedifex/artifact/time_stamp/date.lux new file mode 100644 index 000000000..18df2900b --- /dev/null +++ b/stdlib/source/program/aedifex/artifact/time_stamp/date.lux @@ -0,0 +1,39 @@ +(.module: + [lux #* + [abstract + [monad (#+ do)]] + [control + ["<>" parser + ["<.>" text (#+ Parser)]]] + [data + [text + ["%" format]]] + [math + [number + ["n" nat]]] + [time + ["." date (#+ Date)] + ["." year] + ["." month]]]) + +(def: #export (pad value) + (-> Nat Text) + (if (n.< 10 value) + (%.format "0" (%.nat value)) + (%.nat value))) + +(def: #export (format value) + (%.Format Date) + (%.format (|> value date.year year.value .nat %.nat) + (|> value date.month month.number ..pad) + (|> value date.day_of_month ..pad))) + +(def: #export parser + (Parser Date) + (do <>.monad + [year (<>.codec n.decimal (.exactly 4 .decimal)) + year (<>.lift (year.year (.int year))) + month (<>.codec n.decimal (.exactly 2 .decimal)) + month (<>.lift (month.by_number month)) + day_of_month (<>.codec n.decimal (.exactly 2 .decimal))] + (<>.lift (date.date year month day_of_month)))) diff --git a/stdlib/source/program/aedifex/artifact/time_stamp/time.lux b/stdlib/source/program/aedifex/artifact/time_stamp/time.lux new file mode 100644 index 000000000..d14f0a435 --- /dev/null +++ b/stdlib/source/program/aedifex/artifact/time_stamp/time.lux @@ -0,0 +1,35 @@ +(.module: + [lux #* + ["." time (#+ Time)] + [abstract + [monad (#+ do)]] + [control + ["<>" parser + ["<.>" text (#+ Parser)]]] + [data + [text + ["%" format]]] + [math + [number + ["n" nat]]]] + ["." // #_ + ["#" date]]) + +(def: #export (format value) + (%.Format Time) + (let [(^slots [#time.hour #time.minute #time.second]) (time.clock value)] + (%.format (//.pad hour) + (//.pad minute) + (//.pad second)))) + +(def: #export parser + (.Parser Time) + (do <>.monad + [hour (<>.codec n.decimal (.exactly 2 .decimal)) + minute (<>.codec n.decimal (.exactly 2 .decimal)) + second (<>.codec n.decimal (.exactly 2 .decimal))] + (<>.lift (time.time + {#time.hour hour + #time.minute minute + #time.second second + #time.milli_second 0})))) diff --git a/stdlib/source/program/aedifex/artifact/value.lux b/stdlib/source/program/aedifex/artifact/value.lux new file mode 100644 index 000000000..eb5c33c22 --- /dev/null +++ b/stdlib/source/program/aedifex/artifact/value.lux @@ -0,0 +1,53 @@ +(.module: + [lux (#- Name Type) + [abstract + [equivalence (#+ Equivalence)]] + [data + ["." product] + ["." text + ["%" format]] + [format + ["." xml]] + [collection + ["." list ("#\." functor)]]] + [math + [number + ["n" nat]]] + ["." time (#+ Time) + ["." instant (#+ Instant)] + ["." date (#+ Date)] + ["." year] + ["." month]]] + [// (#+ Version) + [type (#+ Type)] + ["." time_stamp (#+ Time_Stamp)]]) + +(type: #export Build + Nat) + +(type: #export Value + {#version Version + #time_stamp Time_Stamp + #build Build}) + +(def: #export equivalence + (Equivalence Value) + ($_ product.equivalence + text.equivalence + instant.equivalence + n.equivalence + )) + +(def: separator + "-") + +(def: snapshot + "SNAPSHOT") + +(def: #export (format [version time_stamp build]) + (%.Format Value) + (%.format (text.replace_all ..snapshot + (time_stamp.format time_stamp) + version) + ..separator + (%.nat build))) diff --git a/stdlib/source/program/aedifex/artifact/versioning.lux b/stdlib/source/program/aedifex/artifact/versioning.lux new file mode 100644 index 000000000..df9f7dfa3 --- /dev/null +++ b/stdlib/source/program/aedifex/artifact/versioning.lux @@ -0,0 +1,176 @@ +(.module: + [lux (#- Name Type) + [abstract + [equivalence (#+ Equivalence)] + [monad (#+ do)]] + [control + ["." exception (#+ exception:)] + ["<>" parser + ["<.>" xml (#+ Parser)] + ["<.>" text]]] + [data + ["." product] + ["." text + ["%" format]] + [format + ["." xml (#+ XML)]] + [collection + ["." list ("#\." functor)]]] + [math + [number + ["n" nat]]] + ["." time (#+ Time) + ["." instant (#+ Instant)] + ["." date (#+ Date)] + ["." year] + ["." month]]] + ["." // (#+ Version) + [type (#+ Type)] + ["#." value (#+ Build Value)] + ["#." time_stamp (#+ Time_Stamp) + ["#/." date] + ["#/." time]]]) + +(type: #export Versioning + {#time_stamp Time_Stamp + #build Build + #snapshot (List Type)}) + +(def: #export init + {#time_stamp (instant.from_millis +0) + #build 0 + #snapshot (list)}) + +(def: #export equivalence + (Equivalence Versioning) + ($_ product.equivalence + instant.equivalence + n.equivalence + (list.equivalence text.equivalence) + )) + +(template [ ] + [(def: xml.Tag ["" ])] + + [ "extension"] + [ "value"] + [ "updated"] + + [ "timestamp"] + [ "buildNumber"] + [ "lastUpdated"] + + [ "snapshotVersions"] + [ "snapshotVersion"] + + [ "snapshot"] + [ "versioning"] + ) + +(def: (instant_format value) + (%.Format Instant) + (%.format (//time_stamp/date.format (instant.date value)) + (//time_stamp/time.format (instant.time value)))) + +(template [
]
+  [(def: 
+     (->  XML)
+     (|>> 
 #xml.Text list (#xml.Node  xml.attributes)))]
+
+  [format_extension Type .. (|>)]
+  [format_value Value .. //value.format]
+  [format_updated Instant .. ..instant_format]
+
+  [format_time_stamp Instant .. //time_stamp.format]
+  [format_build_number Nat .. %.nat]
+  [format_last_updated Instant .. ..instant_format]
+  )
+
+(def: (format_snapshot value type)
+  (-> Value Type XML)
+  (<| (#xml.Node .. xml.attributes)
+      (list (..format_extension type)
+            (..format_value value)
+            (let [[version time_stamp build] value]
+              (..format_updated time_stamp)))))
+
+(def: #export (format version (^slots [#time_stamp #build #snapshot]))
+  (-> Version Versioning XML)
+  (<| (#xml.Node .. xml.attributes)
+      (list (<| (#xml.Node .. xml.attributes)
+                (list (..format_time_stamp time_stamp)
+                      (..format_build_number build)))
+            (..format_last_updated time_stamp)
+            (<| (#xml.Node .. xml.attributes)
+                (list\map (..format_snapshot [version time_stamp build])
+                          snapshot)))))
+
+(exception: #export (time_stamp_mismatch {expected Time_Stamp} {actual Text})
+  (exception.report
+   ["Expected time-stamp" (instant_format expected)]
+   ["Actual time-stamp" actual]))
+
+(exception: #export (value_mismatch {expected Value} {actual Text})
+  (exception.report
+   ["Expected" (//value.format expected)]
+   ["Actual" actual]))
+
+(def: (sub tag parser)
+  (All [a] (-> xml.Tag (Parser a) (Parser a)))
+  (do <>.monad
+    [_ (.node tag)]
+    (.children parser)))
+
+(def: (text tag)
+  (-> xml.Tag (Parser Text))
+  (..sub tag .text))
+
+(def: last_updated_parser
+  (Parser Instant)
+  (.embed (do <>.monad
+                  [date //time_stamp/date.parser
+                   time //time_stamp/time.parser]
+                  (wrap (instant.from_date_time date time)))
+                (..text ..)))
+
+(def: time_stamp_parser
+  (Parser Time_Stamp)
+  (.embed //time_stamp.parser
+                (..text ..)))
+
+(def: build_parser
+  (Parser Build)
+  (.embed (<>.codec n.decimal
+                          (.many .decimal))
+                (..text ..)))
+
+(def: (snapshot_parser expected)
+  (-> Value (Parser Type))
+  (<| (..sub ..)
+      (do <>.monad
+        [#let [[version time_stamp build] expected]
+         updated (.somewhere (..text ..))
+         _ (<>.assert (exception.construct ..time_stamp_mismatch [time_stamp updated])
+                      (\ text.equivalence = (instant_format time_stamp) updated))
+         actual (.somewhere (..text ..))
+         _ (<>.assert (exception.construct ..value_mismatch [expected actual])
+                      (\ text.equivalence = (//value.format expected) actual))]
+        (.somewhere (..text ..)))))
+
+(def: #export (parser version)
+  (-> Version (Parser Versioning))
+  (<| (..sub ..)
+      (do <>.monad
+        [[time_stamp build] (<| .somewhere
+                                (..sub ..)
+                                (<>.and (.somewhere ..time_stamp_parser)
+                                        (.somewhere ..build_parser)))
+         last_updated (.somewhere ..last_updated_parser)
+         _ (<>.assert (exception.construct ..time_stamp_mismatch [time_stamp (instant_format last_updated)])
+                      (\ instant.equivalence = time_stamp last_updated))
+         snapshot (<| .somewhere
+                      (..sub ..)
+                      (<>.some (..snapshot_parser [version time_stamp build])))]
+        (wrap {#time_stamp time_stamp
+               #build build
+               #snapshot snapshot}))))
diff --git a/stdlib/source/program/aedifex/repository/local.lux b/stdlib/source/program/aedifex/repository/local.lux
index 393861ccf..f313b3176 100644
--- a/stdlib/source/program/aedifex/repository/local.lux
+++ b/stdlib/source/program/aedifex/repository/local.lux
@@ -42,7 +42,7 @@
       [_ (: (Promise (Try Path))
             (file.make_directories promise.monad system (file.parent system absolute_path)))]
       (: (Promise (Try (File Promise)))
-         (file.get_file promise.monad system absolute_path)))))
+         (!.use (\ system file) absolute_path)))))
 
 (structure: #export (repository program system)
   (-> (Program Promise) (file.System Promise) (//.Repository Promise))
-- 
cgit v1.2.3