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. --- stdlib/source/program/aedifex/cache.lux | 8 +- stdlib/source/program/aedifex/command/install.lux | 2 +- stdlib/source/program/aedifex/command/pom.lux | 2 +- .../program/aedifex/dependency/resolution.lux | 4 +- stdlib/source/program/aedifex/input.lux | 2 +- stdlib/source/program/aedifex/metadata.lux | 8 ++ .../source/program/aedifex/metadata/artifact.lux | 151 +++++++++++++++++++++ 7 files changed, 168 insertions(+), 9 deletions(-) create mode 100644 stdlib/source/program/aedifex/metadata.lux create mode 100644 stdlib/source/program/aedifex/metadata/artifact.lux (limited to 'stdlib/source/program/aedifex') diff --git a/stdlib/source/program/aedifex/cache.lux b/stdlib/source/program/aedifex/cache.lux index d6a8a70ef..50062c3f7 100644 --- a/stdlib/source/program/aedifex/cache.lux +++ b/stdlib/source/program/aedifex/cache.lux @@ -57,16 +57,16 @@ (|> package (get@ #//package.sha-1) (\ //hash.sha-1-codec encode) - encoding.to-utf8) + (\ encoding.utf8 encode)) (format prefix //artifact/extension.sha-1)) _ (..write! system (|> package (get@ #//package.md5) (\ //hash.md5-codec encode) - encoding.to-utf8) + (\ encoding.utf8 encode)) (format prefix //artifact/extension.md5)) _ (..write! system - (|> package (get@ #//package.pom) (\ xml.codec encode) encoding.to-utf8) + (|> package (get@ #//package.pom) (\ xml.codec encode) (\ encoding.utf8 encode)) (format prefix //artifact/extension.pom))] (wrap artifact)))) @@ -91,7 +91,7 @@ (All [a] (-> (Codec Text a) Binary (Try a))) (let [(^open "_\.") try.monad] (|> data - encoding.from-utf8 + (\ encoding.utf8 decode) (_\map (\ codec decode)) _\join))) diff --git a/stdlib/source/program/aedifex/command/install.lux b/stdlib/source/program/aedifex/command/install.lux index d11d96a0c..67dc242ac 100644 --- a/stdlib/source/program/aedifex/command/install.lux +++ b/stdlib/source/program/aedifex/command/install.lux @@ -62,7 +62,7 @@ _ (..save! system (binary.run tar.writer package) (format artifact-name ///artifact/extension.lux-library)) pom (\ promise.monad wrap (///pom.write profile)) - _ (..save! system (|> pom (\ xml.codec encode) encoding.to-utf8) + _ (..save! system (|> pom (\ xml.codec encode) (\ encoding.utf8 encode)) (format artifact-name ///artifact/extension.pom))] (console.write-line //clean.success console))) diff --git a/stdlib/source/program/aedifex/command/pom.lux b/stdlib/source/program/aedifex/command/pom.lux index cf07ad0e0..618c6b4b9 100644 --- a/stdlib/source/program/aedifex/command/pom.lux +++ b/stdlib/source/program/aedifex/command/pom.lux @@ -32,7 +32,7 @@ (file.get-file promise.monad fs ///pom.file)) outcome (|> pom (\ xml.codec encode) - encoding.to-utf8 + (\ encoding.utf8 encode) (!.use (\ file over-write))) _ (console.write-line //clean.success console)] (wrap ///pom.file))) diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux index d21adaf0c..e8b0f2dba 100644 --- a/stdlib/source/program/aedifex/dependency/resolution.lux +++ b/stdlib/source/program/aedifex/dependency/resolution.lux @@ -61,7 +61,7 @@ [actual (\ repository download artifact extension)] (\ promise.monad wrap (do try.monad - [output (encoding.from-utf8 actual) + [output (\ encoding.utf8 decode actual) actual (\ codec decode output) _ (exception.assert exception [dependency output] (\ ///hash.equivalence = (hash library) actual))] @@ -82,7 +82,7 @@ pom (\ repository download artifact ///artifact/extension.pom)] (\ promise.monad wrap (do try.monad - [pom (encoding.from-utf8 pom) + [pom (\ encoding.utf8 decode pom) pom (\ xml.codec decode pom) profile (.run ///pom.parser pom)] (wrap {#///package.origin #///package.Remote diff --git a/stdlib/source/program/aedifex/input.lux b/stdlib/source/program/aedifex/input.lux index e2bc72154..623346237 100644 --- a/stdlib/source/program/aedifex/input.lux +++ b/stdlib/source/program/aedifex/input.lux @@ -43,7 +43,7 @@ (def: parse-project (-> Binary (Try Project)) (|>> (do> try.monad - [encoding.from-utf8] + [(\ encoding.utf8 decode)] [..parse-lux] [(list) (.run //parser.project)]))) 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 [ ] + [(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