diff options
author | Eduardo Julian | 2020-12-15 22:05:05 -0400 |
---|---|---|
committer | Eduardo Julian | 2020-12-15 22:05:05 -0400 |
commit | abc5c5293603229b447b8b5dfa7f3275571ad982 (patch) | |
tree | 26a5a40c6583568522ca9d3714219112e602a693 /stdlib/source/program | |
parent | 71ade9a07f08c0d61ebd70e64c2745f1ba33cb54 (diff) |
Compiling "lux syntax char case!" with TABLESWITCH instead of LOOKUPSWITCH.
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/program/aedifex/artifact/extension.lux | 8 | ||||
-rw-r--r-- | stdlib/source/program/aedifex/metadata/snapshot.lux | 286 |
2 files changed, 292 insertions, 2 deletions
diff --git a/stdlib/source/program/aedifex/artifact/extension.lux b/stdlib/source/program/aedifex/artifact/extension.lux index 78939260a..e108a3727 100644 --- a/stdlib/source/program/aedifex/artifact/extension.lux +++ b/stdlib/source/program/aedifex/artifact/extension.lux @@ -1,7 +1,7 @@ (.module: - [lux #* + [lux (#- type) [data - [text + ["." text ["%" format (#+ format)]]] [macro ["." template]]] @@ -18,6 +18,10 @@ (-> //.Type Extension) (|>> (format ..separator))) +(def: #export type + (-> Extension //.Type) + (text.replace-all ..separator "")) + (template [<name>] [(def: #export <name> Extension diff --git a/stdlib/source/program/aedifex/metadata/snapshot.lux b/stdlib/source/program/aedifex/metadata/snapshot.lux new file mode 100644 index 000000000..a94ac33c4 --- /dev/null +++ b/stdlib/source/program/aedifex/metadata/snapshot.lux @@ -0,0 +1,286 @@ +(.module: + [lux (#- Name Type) + [abstract + [monad (#+ do)] + [equivalence (#+ Equivalence)]] + [control + ["." exception (#+ exception:)] + ["<>" parser + ["<.>" xml (#+ Parser)] + ["<.>" text]]] + [data + ["." product] + ["." text + ["%" format (#+ format)]] + [number + ["n" nat]] + [format + ["." xml (#+ XML)]] + [collection + ["." list ("#\." functor)]]] + ["." time (#+ Time) + ["." instant (#+ Instant)] + ["." date (#+ Date)] + ["." year] + ["." month]]] + ["." /// #_ + ["#." artifact (#+ Group Name Version Artifact) + ["#/." type (#+ Type)]]]) + +(def: snapshot + "SNAPSHOT") + +(type: #export Time-Stamp + Instant) + +(type: #export Build + Nat) + +(type: #export Versioning + {#time-stamp Time-Stamp + #build Build + #snapshot (List Type)}) + +(type: #export Value + [Version Time-Stamp Build]) + +(type: #export Metadata + {#group Group + #name Name + #version Version + #versioning Versioning}) + +(def: (pad value) + (-> Nat Text) + (if (n.< 10 value) + (format "0" (%.nat value)) + (%.nat value))) + +(def: (date-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: (time-format value) + (%.Format Time) + (let [(^slots [#time.hour #time.minute #time.second]) (time.clock value)] + (format (..pad hour) + (..pad minute) + (..pad second)))) + +(def: (instant-format value) + (%.Format Instant) + (format (..date-format (instant.date value)) + (..time-format (instant.time value)))) + +(template [<separator> <name>] + [(def: <name> + <separator>)] + + ["." time-stamp-separator] + ["-" value-separator] + ) + +(def: (time-stamp-format value) + (%.Format Time-Stamp) + (format (..date-format (instant.date value)) + ..time-stamp-separator + (..time-format (instant.time value)))) + +(def: (value-format [version time-stamp build]) + (%.Format Value) + (format (text.replace-all ..snapshot + (..time-stamp-format time-stamp) + version) + ..value-separator + (%.nat build))) + +(template [<definition> <tag>] + [(def: <definition> xml.Tag ["" <tag>])] + + [<group> "groupId"] + [<name> "artifactId"] + [<version> "version"] + [<last-updated> "lastUpdated"] + [<metadata> "metadata"] + [<versioning> "versioning"] + [<snapshot> "snapshot"] + [<timestamp> "timestamp"] + [<build-number> "buildNumber"] + [<snapshot-versions> "snapshotVersions"] + [<snapshot-version> "snapshotVersion"] + [<extension> "extension"] + [<value> "value"] + [<updated> "updated"] + ) + +(template [<name> <type> <tag> <pre>] + [(def: <name> + (-> <type> XML) + (|>> <pre> #xml.Text list (#xml.Node <tag> xml.attributes)))] + + [write-group Group ..<group> (|>)] + [write-name Name ..<name> (|>)] + [write-version Version ..<version> (|>)] + [write-last-updated Instant ..<last-updated> ..instant-format] + [write-time-stamp Instant ..<timestamp> ..time-stamp-format] + [write-build-number Nat ..<build-number> %.nat] + [write-extension Type ..<extension> (|>)] + [write-value Value ..<value> ..value-format] + [write-updated Instant ..<updated> ..instant-format] + ) + +(def: (write-snapshot value type) + (-> Value Type XML) + (<| (#xml.Node ..<snapshot-version> xml.attributes) + (list (..write-extension type) + (..write-value value) + (let [[version time-stamp build] value] + (..write-updated time-stamp))))) + +(def: (write-versioning version (^slots [#time-stamp #build #snapshot])) + (-> Version Versioning XML) + (<| (#xml.Node ..<versioning> xml.attributes) + (list (<| (#xml.Node ..<snapshot> xml.attributes) + (list (..write-time-stamp time-stamp) + (..write-build-number build))) + (..write-last-updated time-stamp) + (<| (#xml.Node ..<snapshot-versions> xml.attributes) + (list\map (..write-snapshot [version time-stamp build]) + snapshot))))) + +(def: #export (write (^slots [#group #name #version #versioning])) + (-> Metadata XML) + (#xml.Node ..<metadata> + xml.attributes + (list (..write-group group) + (..write-name name) + (..write-version version) + (..write-versioning version versioning)))) + +(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: date-parser + (<text>.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)))) + +(def: time-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})))) + +(def: last-updated-parser + (Parser Instant) + (<text>.embed (do <>.monad + [date ..date-parser + time ..time-parser] + (wrap (instant.from-date-time date time))) + (..text ..<last-updated>))) + +(def: time-stamp-parser + (Parser Time-Stamp) + (<text>.embed (do <>.monad + [date ..date-parser + _ (<text>.this ..time-stamp-separator) + time ..time-parser] + (wrap (instant.from-date-time date time))) + (..text ..<timestamp>))) + +(def: build-parser + (Parser Build) + (<text>.embed (<>.codec n.decimal + (<text>.many <text>.decimal)) + (..text ..<timestamp>))) + +(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: (snapshot-parser expected) + (-> Value (Parser Type)) + (<| (..sub ..<snapshot-versions>) + (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: (versioning-parser version) + (-> Version (Parser Versioning)) + (<| (..sub ..<versioning>) + (do <>.monad + [[time-stamp build] (<| <xml>.somewhere + (..sub ..<snapshot>) + (<>.and ..time-stamp-parser + ..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})))) + +(def: #export parser + (Parser Metadata) + (<| (..sub ..<metadata>) + (do <>.monad + [group (<xml>.somewhere (..text ..<group>)) + name (<xml>.somewhere (..text ..<name>)) + version (<xml>.somewhere (..text ..<version>)) + versioning (<xml>.somewhere (..versioning-parser version))] + (wrap {#group group + #name name + #version version + #versioning versioning})))) + +(def: versioning + (Equivalence Versioning) + ($_ product.equivalence + instant.equivalence + n.equivalence + (list.equivalence text.equivalence) + )) + +(def: #export equivalence + (Equivalence Metadata) + ($_ product.equivalence + text.equivalence + text.equivalence + text.equivalence + ..versioning + )) |