New "parser" hierarchy. [Part 5]

2 files changed, 152 insertions, 0 deletions

diff --git a/stdlib/source/parser/lux/data/collection/tree.lux b/stdlib/source/parser/lux/data/collection/tree.lux
new file mode 100644
index 000000000..5d10ce15b
--- /dev/null
+++ b/stdlib/source/parser/lux/data/collection/tree.lux
@@ -0,0 +1,59 @@
+(.require
+ [library
+  [lux (.except left right)
+   [abstract
+    [monad (.only do)]]
+   [control
+    ["//" parser]
+    ["[0]" try (.only Try)]
+    ["[0]" exception (.only exception)]]]]
+ [\\library
+  [/ (.only Tree)
+   ["[0]" zipper (.only Zipper)]]])
+
+(type .public (Parser t a)
+  (//.Parser (Zipper t) a))
+
+(def .public (result' parser zipper)
+  (All (_ t a) (-> (Parser t a) (Zipper t) (Try a)))
+  (do try.monad
+    [[zipper output] (//.result parser zipper)]
+    (in output)))
+
+(def .public (result parser tree)
+  (All (_ t a) (-> (Parser t a) (Tree t) (Try a)))
+  (result' parser (zipper.zipper tree)))
+
+(def .public value
+  (All (_ t) (Parser t t))
+  (function (_ zipper)
+    {try.#Success [zipper (zipper.value zipper)]}))
+
+(exception .public cannot_move_further)
+
+(with_template [<name> <direction>]
+  [(def .public <name>
+     (All (_ t) (Parser t []))
+     (function (_ zipper)
+       (case (<direction> zipper)
+         {.#None}
+         (exception.except ..cannot_move_further [])
+
+         {.#Some next}
+         {try.#Success [next []]})))]
+
+  [down      zipper.down]
+  [up        zipper.up]
+
+  [right     zipper.right]
+  [rightmost zipper.rightmost]
+
+  [left      zipper.left]
+  [leftmost  zipper.leftmost]
+  
+  [next      zipper.next]
+  [end       zipper.end]
+  
+  [previous  zipper.previous]
+  [start     zipper.start]
+  )
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))