New "parser" hierarchy. [Part 5]

1 files changed, 93 insertions, 0 deletions

diff --git a/stdlib/source/parser/lux/program.lux b/stdlib/source/parser/lux/program.lux
new file mode 100644
index 000000000..e834136d8
--- /dev/null
+++ b/stdlib/source/parser/lux/program.lux
@@ -0,0 +1,93 @@
+(.require
+ [library
+  [lux (.except parameter)
+   [abstract
+    [monad (.only do)]]
+   [control
+    ["//" parser]
+    ["[0]" try (.only Try)]]
+   [data
+    ["[0]" text (.use "[1]#[0]" equivalence)
+     ["%" \\format (.only format)]]]]])
+
+(type .public (Parser a)
+  (//.Parser (List Text) a))
+
+(def .public (result parser inputs)
+  (All (_ a) (-> (Parser a) (List Text) (Try a)))
+  (case (//.result parser inputs)
+    {try.#Success [remaining output]}
+    (case remaining 
+      {.#End}
+      {try.#Success output}
+
+      _
+      {try.#Failure (format "Remaining CLI inputs: " (text.interposed " " remaining))})
+
+    {try.#Failure try}
+    {try.#Failure try}))
+
+(def .public any
+  (Parser Text)
+  (function (_ inputs)
+    (case inputs
+      {.#Item arg inputs'}
+      {try.#Success [inputs' arg]}
+      
+      _
+      {try.#Failure "Cannot parse empty arguments."})))
+
+(def .public (parse parser)
+  (All (_ a) (-> (-> Text (Try a)) (Parser a)))
+  (function (_ inputs)
+    (do try.monad
+      [[remaining raw] (any inputs)
+       output (parser raw)]
+      (in [remaining output]))))
+
+(def .public (this reference)
+  (-> Text (Parser Any))
+  (function (_ inputs)
+    (do try.monad
+      [[remaining raw] (any inputs)]
+      (if (text#= reference raw)
+        (in [remaining []])
+        {try.#Failure (format "Missing token: '" reference "'")}))))
+
+(def .public (somewhere cli)
+  (All (_ a) (-> (Parser a) (Parser a)))
+  (function (_ inputs)
+    (loop (again [immediate inputs])
+      (case (//.result cli immediate)
+        {try.#Success [remaining output]}
+        {try.#Success [remaining output]}
+
+        {try.#Failure try}
+        (case immediate
+          {.#End}
+          {try.#Failure try}
+          
+          {.#Item to_omit immediate'}
+          (do try.monad
+            [[remaining output] (again immediate')]
+            (in [{.#Item to_omit remaining}
+                 output])))))))
+
+(def .public end
+  (Parser Any)
+  (function (_ inputs)
+    (case inputs
+      {.#End} {try.#Success [inputs []]}
+      _       {try.#Failure (format "Unknown parameters: " (text.interposed " " inputs))})))
+
+(def .public (named name value)
+  (All (_ a) (-> Text (Parser a) (Parser a)))
+  (|> value
+      (//.after (..this name))
+      ..somewhere))
+
+(def .public (parameter [short long] value)
+  (All (_ a) (-> [Text Text] (Parser a) (Parser a)))
+  (|> value
+      (//.after (//.either (..this short) (..this long)))
+      ..somewhere))