From dff517cbdb9a1c80028782c62ad91c71ddb34909 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 11 Dec 2020 22:40:31 -0400 Subject: Improved parsing speed for Lux code. --- .../source/program/aedifex/metadata/artifact.lux | 151 +++++++++++++++++++++ 1 file changed, 151 insertions(+) create mode 100644 stdlib/source/program/aedifex/metadata/artifact.lux (limited to 'stdlib/source/program/aedifex/metadata') 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 [ ] + [(def: xml.Tag ["" ])] + + [ "groupId"] + [ "artifactId"] + [ "version"] + [ "versions"] + [ "lastUpdated"] + [ "metadata"] + ) + +(template [
]
+  [(def: 
+     (->  XML)
+     (|>> 
 #xml.Text list (#xml.Node  xml.attributes)))]
+
+  [write-group Group .. (|>)]
+  [write-name Name .. (|>)]
+  [write-version Version .. (|>)]
+  [write-last-updated Instant .. ..instant-format]
+  )
+
+(def: write-versions
+  (-> (List Version) XML)
+  (|>> (list\map ..write-version) (#xml.Node .. xml.attributes)))
+
+(def: #export (write value)
+  (-> Metadata XML)
+  (#xml.Node ..
+             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
+    [_ (.node tag)]
+    (.children parser)))
+
+(def: (text tag)
+  (-> xml.Tag (Parser Text))
+  (..sub tag .text))
+
+(def: date-parser
+  (.Parser Date)
+  (do <>.monad
+    [year (<>.codec n.decimal (.exactly 4 .decimal))
+     year (<>.lift (year.year (.int year)))
+     month (<>.codec n.decimal (.exactly 2 .decimal))
+     month (<>.lift (month.by-number month))
+     day-of-month (<>.codec n.decimal (.exactly 2 .decimal))]
+    (<>.lift (date.date year month day-of-month))))
+
+(def: time-parser
+  (.Parser Time)
+  (do <>.monad
+    [hour (<>.codec n.decimal (.exactly 2 .decimal))
+     minute (<>.codec n.decimal (.exactly 2 .decimal))
+     second (<>.codec n.decimal (.exactly 2 .decimal))]
+    (<>.lift (time.time
+              {#time.hour hour
+               #time.minute minute
+               #time.second second
+               #time.milli-second 0}))))
+
+(def: last-updated-parser
+  (Parser Instant)
+  (.embed (do <>.monad
+                  [date ..date-parser
+                   time ..time-parser]
+                  (wrap (instant.from-date-time date time)))
+                (..text ..)))
+
+(def: #export parser
+  (Parser Metadata)
+  (<| (..sub ..)
+      ($_ <>.and
+          (.somewhere (..text ..))
+          (.somewhere (..text ..))
+          (.somewhere (<| (..sub ..)
+                               (<>.many (..text ..))))
+          (.somewhere ..last-updated-parser)
+          )))
+
+(def: #export equivalence
+  (Equivalence Metadata)
+  ($_ product.equivalence
+      text.equivalence
+      text.equivalence
+      (list.equivalence text.equivalence)
+      instant.equivalence
+      ))
-- 
cgit v1.2.3