diff options
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/program/aedifex/metadata.lux | 8 | ||||
-rw-r--r-- | stdlib/source/program/aedifex/metadata/artifact.lux | 151 |
2 files changed, 159 insertions, 0 deletions
diff --git a/stdlib/source/program/aedifex/metadata.lux b/stdlib/source/program/aedifex/metadata.lux new file mode 100644 index 000000000..0eca976c0 --- /dev/null +++ b/stdlib/source/program/aedifex/metadata.lux @@ -0,0 +1,8 @@ +(.module: + [lux #* + [world + [file (#+ Path)]]]) + +(def: #export file + Path + "maven-metadata.xml") diff --git a/stdlib/source/program/aedifex/metadata/artifact.lux b/stdlib/source/program/aedifex/metadata/artifact.lux new file mode 100644 index 000000000..1f8068111 --- /dev/null +++ b/stdlib/source/program/aedifex/metadata/artifact.lux @@ -0,0 +1,151 @@ +(.module: + [lux (#- Name) + [abstract + [monad (#+ do)] + [equivalence (#+ Equivalence)]] + [control + ["<>" 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: #export Metadata + {#group Group + #name Name + #versions (List Version) + #last-updated Instant}) + +(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 [<definition> <tag>] + [(def: <definition> xml.Tag ["" <tag>])] + + [<group> "groupId"] + [<name> "artifactId"] + [<version> "version"] + [<versions> "versions"] + [<last-updated> "lastUpdated"] + [<metadata> "metadata"] + ) + +(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] + ) + +(def: write-versions + (-> (List Version) XML) + (|>> (list\map ..write-version) (#xml.Node ..<versions> xml.attributes))) + +(def: #export (write value) + (-> Metadata XML) + (#xml.Node ..<metadata> + xml.attributes + (list (..write-group (get@ #group value)) + (..write-name (get@ #name value)) + (..write-versions (get@ #versions value)) + (..write-last-updated (get@ #last-updated value))))) + +(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: #export parser + (Parser Metadata) + (<| (..sub ..<metadata>) + ($_ <>.and + (<xml>.somewhere (..text ..<group>)) + (<xml>.somewhere (..text ..<name>)) + (<xml>.somewhere (<| (..sub ..<versions>) + (<>.many (..text ..<version>)))) + (<xml>.somewhere ..last-updated-parser) + ))) + +(def: #export equivalence + (Equivalence Metadata) + ($_ product.equivalence + text.equivalence + text.equivalence + (list.equivalence text.equivalence) + instant.equivalence + )) |