diff options
Diffstat (limited to 'stdlib/source/program/aedifex/artifact')
| -rw-r--r-- | stdlib/source/program/aedifex/artifact/versioning.lux | 149 |
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)) + ))) |