aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/program
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/program/aedifex.lux4
-rw-r--r--stdlib/source/program/aedifex/artifact/time_stamp.lux35
-rw-r--r--stdlib/source/program/aedifex/artifact/time_stamp/date.lux39
-rw-r--r--stdlib/source/program/aedifex/artifact/time_stamp/time.lux35
-rw-r--r--stdlib/source/program/aedifex/artifact/value.lux53
-rw-r--r--stdlib/source/program/aedifex/artifact/versioning.lux176
-rw-r--r--stdlib/source/program/aedifex/repository/local.lux2
7 files changed, 341 insertions, 3 deletions
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
+ _ (<text>.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 (<text>.exactly 4 <text>.decimal))
+ year (<>.lift (year.year (.int year)))
+ month (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))
+ month (<>.lift (month.by_number month))
+ day_of_month (<>.codec n.decimal (<text>.exactly 2 <text>.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
+ (<text>.Parser Time)
+ (do <>.monad
+ [hour (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))
+ minute (<>.codec n.decimal (<text>.exactly 2 <text>.decimal))
+ second (<>.codec n.decimal (<text>.exactly 2 <text>.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 [<definition> <tag>]
+ [(def: <definition> xml.Tag ["" <tag>])]
+
+ [<extension> "extension"]
+ [<value> "value"]
+ [<updated> "updated"]
+
+ [<timestamp> "timestamp"]
+ [<build_number> "buildNumber"]
+ [<last_updated> "lastUpdated"]
+
+ [<snapshot_versions> "snapshotVersions"]
+ [<snapshot_version> "snapshotVersion"]
+
+ [<snapshot> "snapshot"]
+ [<versioning> "versioning"]
+ )
+
+(def: (instant_format value)
+ (%.Format Instant)
+ (%.format (//time_stamp/date.format (instant.date value))
+ (//time_stamp/time.format (instant.time value))))
+
+(template [<name> <type> <tag> <pre>]
+ [(def: <name>
+ (-> <type> XML)
+ (|>> <pre> #xml.Text list (#xml.Node <tag> xml.attributes)))]
+
+ [format_extension Type ..<extension> (|>)]
+ [format_value Value ..<value> //value.format]
+ [format_updated Instant ..<updated> ..instant_format]
+
+ [format_time_stamp Instant ..<timestamp> //time_stamp.format]
+ [format_build_number Nat ..<build_number> %.nat]
+ [format_last_updated Instant ..<last_updated> ..instant_format]
+ )
+
+(def: (format_snapshot value type)
+ (-> Value Type XML)
+ (<| (#xml.Node ..<snapshot_version> 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 ..<versioning> xml.attributes)
+ (list (<| (#xml.Node ..<snapshot> xml.attributes)
+ (list (..format_time_stamp time_stamp)
+ (..format_build_number build)))
+ (..format_last_updated time_stamp)
+ (<| (#xml.Node ..<snapshot_versions> 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
+ [_ (<xml>.node tag)]
+ (<xml>.children parser)))
+
+(def: (text tag)
+ (-> xml.Tag (Parser Text))
+ (..sub tag <xml>.text))
+
+(def: last_updated_parser
+ (Parser Instant)
+ (<text>.embed (do <>.monad
+ [date //time_stamp/date.parser
+ time //time_stamp/time.parser]
+ (wrap (instant.from_date_time date time)))
+ (..text ..<last_updated>)))
+
+(def: time_stamp_parser
+ (Parser Time_Stamp)
+ (<text>.embed //time_stamp.parser
+ (..text ..<timestamp>)))
+
+(def: build_parser
+ (Parser Build)
+ (<text>.embed (<>.codec n.decimal
+ (<text>.many <text>.decimal))
+ (..text ..<build_number>)))
+
+(def: (snapshot_parser expected)
+ (-> Value (Parser Type))
+ (<| (..sub ..<snapshot_version>)
+ (do <>.monad
+ [#let [[version time_stamp build] expected]
+ updated (<xml>.somewhere (..text ..<updated>))
+ _ (<>.assert (exception.construct ..time_stamp_mismatch [time_stamp updated])
+ (\ text.equivalence = (instant_format time_stamp) updated))
+ actual (<xml>.somewhere (..text ..<value>))
+ _ (<>.assert (exception.construct ..value_mismatch [expected actual])
+ (\ text.equivalence = (//value.format expected) actual))]
+ (<xml>.somewhere (..text ..<extension>)))))
+
+(def: #export (parser version)
+ (-> Version (Parser Versioning))
+ (<| (..sub ..<versioning>)
+ (do <>.monad
+ [[time_stamp build] (<| <xml>.somewhere
+ (..sub ..<snapshot>)
+ (<>.and (<xml>.somewhere ..time_stamp_parser)
+ (<xml>.somewhere ..build_parser)))
+ last_updated (<xml>.somewhere ..last_updated_parser)
+ _ (<>.assert (exception.construct ..time_stamp_mismatch [time_stamp (instant_format last_updated)])
+ (\ instant.equivalence = time_stamp last_updated))
+ snapshot (<| <xml>.somewhere
+ (..sub ..<snapshot_versions>)
+ (<>.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))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 15:51:53 +0000