aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/program
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/program/aedifex/artifact/versioning.lux149
1 files changed, 35 insertions, 114 deletions
diff --git a/stdlib/source/program/aedifex/artifact/versioning.lux b/stdlib/source/program/aedifex/artifact/versioning.lux
index df9f7dfa3..41b3179d3 100644
--- a/stdlib/source/program/aedifex/artifact/versioning.lux
+++ b/stdlib/source/program/aedifex/artifact/versioning.lux
@@ -1,5 +1,5 @@
(.module:
- [lux (#- Name Type)
+ [lux #*
[abstract
[equivalence (#+ Equivalence)]
[monad (#+ do)]]
@@ -10,6 +10,7 @@
["<.>" text]]]
[data
["." product]
+ ["." maybe]
["." text
["%" format]]
[format
@@ -24,96 +25,50 @@
["." date (#+ Date)]
["." year]
["." month]]]
- ["." // (#+ Version)
- [type (#+ Type)]
- ["#." value (#+ Build Value)]
- ["#." time_stamp (#+ Time_Stamp)
- ["#/." date]
- ["#/." time]]])
+ ["." // #_
+ ["#." time]
+ ["#." snapshot (#+ Snapshot)
+ ["#/." version (#+ Version)]]])
(type: #export Versioning
- {#time_stamp Time_Stamp
- #build Build
- #snapshot (List Type)})
+ {#snapshot Snapshot
+ #last_updated Instant
+ #versions (List Version)})
(def: #export init
- {#time_stamp (instant.from_millis +0)
- #build 0
- #snapshot (list)})
+ {#snapshot #//snapshot.Local
+ #last_updated instant.epoch
+ #versions (list)})
(def: #export equivalence
(Equivalence Versioning)
($_ product.equivalence
+ //snapshot.equivalence
instant.equivalence
- n.equivalence
- (list.equivalence text.equivalence)
+ (list.equivalence //snapshot/version.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]
+ [<versioning> "versioning"]
)
-(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: format_last_updated
+ (-> Instant XML)
+ (|>> //time.format #xml.Text list (#xml.Node ..<last_updated> xml.attributes)))
-(def: #export (format version (^slots [#time_stamp #build #snapshot]))
- (-> Version Versioning XML)
+(def: #export (format (^slots [#snapshot #last_updated #versions]))
+ (-> 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]))
+ (list (//snapshot.format snapshot)
+ (..format_last_updated last_updated)
+ (|> versions
+ (list\map //snapshot/version.format)
+ (#xml.Node ..<snapshot_versions> xml.attributes)))))
(def: (sub tag parser)
(All [a] (-> xml.Tag (Parser a) (Parser a)))
@@ -127,50 +82,16 @@
(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>.embed //time.parser
(..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))
+(def: #export parser
+ (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}))))
+ ($_ <>.and
+ (<xml>.somewhere //snapshot.parser)
+ (<xml>.somewhere ..last_updated_parser)
+ (<| <xml>.somewhere
+ (..sub ..<snapshot_versions>)
+ (<>.some //snapshot/version.parser))
+ )))