Improved parsing speed for Lux code.

10 files changed, 174 insertions, 14 deletions

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 (<xml>.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) (<c>.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 [<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
+      ))
diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux
index bd5c10c66..fdd985f2a 100644
--- a/stdlib/source/program/compositor.lux
+++ b/stdlib/source/program/compositor.lux
@@ -21,8 +21,9 @@
     [collection
      ["." dictionary]
      ["." row (#+ Row)]]]
-   [world
+   ["." world #_
     ["." file (#+ File Path)]
+    ["#/." program]
     ## ["." console]
     ]
    [tool
@@ -66,7 +67,7 @@
       (exec (log! (format text.new-line
                           failure-description text.new-line
                           error text.new-line))
-        (io.run (io.exit +1)))
+        (io.run (\ world/program.default exit +1)))
 
       (#try.Success output)
       (wrap output))))
diff --git a/stdlib/source/program/licentia.lux b/stdlib/source/program/licentia.lux
index 032269af3..896f74dab 100644
--- a/stdlib/source/program/licentia.lux
+++ b/stdlib/source/program/licentia.lux
@@ -62,7 +62,7 @@
                 [file (!.use (\ file.default file) [input])
                  blob (!.use (\ file content) [])
                  document (io\wrap (do {! try.monad}
-                                     [raw-json (encoding.from-utf8 blob)
+                                     [raw-json (\ encoding.utf8 decode blob)
                                       json (|> raw-json
                                                (:coerce java/lang/String)
                                                java/lang/String::trim
@@ -73,7 +73,7 @@
                                          (\ ! map /output.license))))
                  output-file (: (IO (Try (File IO)))
                                 (file.get-file io.monad file.default output))]
-                (!.use (\ output-file over-write) (encoding.to-utf8 document))))]
+                (!.use (\ output-file over-write) (\ encoding.utf8 encode document))))]
     (wrap (log! (case ?done
                   (#try.Success _)
                   (success-message output)
diff --git a/stdlib/source/program/scriptum.lux b/stdlib/source/program/scriptum.lux
index aa15e7bfc..2a205287a 100644
--- a/stdlib/source/program/scriptum.lux
+++ b/stdlib/source/program/scriptum.lux
@@ -490,7 +490,7 @@
       [outcome (do (try.with io.monad)
                  [target (: (IO (Try (File IO)))
                             (file.get-file io.monad file.default path))]
-                 (!.use (\ target over-write) (encoding.to-utf8 (md.markdown documentation))))]
+                 (!.use (\ target over-write) (\ encoding.utf8 encode (md.markdown documentation))))]
       (case outcome
         (#try.Failure error)
         (wrap (log! (ex.construct io-error error)))