aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/program/aedifex/metadata
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/program/aedifex/metadata.lux8
-rw-r--r--stdlib/source/program/aedifex/metadata/artifact.lux151
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
+ ))