- Fixed some bugs.

- Added tests for multi-line text and single-line comments.

2 files changed, 106 insertions, 38 deletions

diff --git a/new-luxc/source/luxc/parser.lux b/new-luxc/source/luxc/parser.lux
index 1114ba76c..7670d72c7 100644
--- a/new-luxc/source/luxc/parser.lux
+++ b/new-luxc/source/luxc/parser.lux
@@ -76,6 +76,16 @@
   (l;either (single-line-comment^ where)
             (multi-line-comment^ where)))
 
+(def: (padding^ where)
+  (-> Cursor (Lexer Cursor))
+  (l;either (do Monad<Lexer>
+              [[comment where] (comment^ where)]
+              (padding^ where))
+            (do Monad<Lexer>
+              [[white-space where] (space^ where)]
+              (wrap where))
+            ))
+
 (def: escaped-char^
   (Lexer [Text Char])
   (l;after (l;char #"\\")
@@ -156,11 +166,7 @@
                                raw-char^)]
     (wrap [[where (#;CharS value)]
            (|> where
-               (update@ #;column (function [column]
-                                   ($_ n.+
-                                       +3
-                                       column
-                                       (text;size chunk)))))])))
+               (update@ #;column (|>. ($_ n.+ +3 (text;size chunk)))))])))
 
 (def: (text^ where)
   (-> Cursor (Lexer [AST Cursor]))
@@ -174,7 +180,7 @@
                                   next-line-start? false]
                              (let [next-line (do @
                                                [_ (l;text "\n")]
-                                               (recur text-read
+                                               (recur (format text-read "\n")
                                                       (|> where
                                                           (update@ #;line n.inc)
                                                           (set@ #;column +0))
@@ -194,8 +200,8 @@
                                                           (update@ #;column (n.+ offset-size)))
                                                       false)
                                                (l;fail (format "Each line of a multi-line text must have an appropriate offset!\n"
-                                                               "Expected: " (%i (nat-to-int offset-column)) "\n"
-                                                               "  Actual: " (%i (nat-to-int offset-size)) "\n")))))
+                                                               "Expected: " (%i (nat-to-int offset-column)) " columns.\n"
+                                                               "  Actual: " (%i (nat-to-int offset-size)) " columns.\n")))))
                                  ($_ l;either
                                      (do @
                                        [normal (l;many' (l;none-of "\\\"\n"))]
@@ -233,8 +239,7 @@
                                      (recur (V;add elem elems)
                                             where'))
                                    (do @
-                                     [[_ where'] (l;either (space^ where)
-                                                           (comment^ where))
+                                     [where' (padding^ where)
                                       _ (l;text <close>)]
                                      (wrap [(V;to-list elems)
                                             (|> where'
@@ -261,8 +266,7 @@
                                   (recur (V;add [key val] elems)
                                          where'))
                                 (do @
-                                  [[_ where'] (l;either (space^ where)
-                                                        (comment^ where))
+                                  [where' (padding^ where)
                                    _ (l;text "}")]
                                   (wrap [(V;to-list elems)
                                          (|> where'
@@ -274,7 +278,7 @@
   (Lexer Text)
   (do Monad<Lexer>
     [#let [digits "0123456789"
-           delimiters "()[]{}#;"
+           delimiters "()[]{}#;\""
            space "\t\v \n\r\f"
            head-lexer (l;none-of (format digits delimiters space))
            tail-lexer (l;some' (l;none-of (format delimiters space)))]
@@ -315,7 +319,7 @@
        [[value length] <lexer>]
        (wrap [[where (<tag> value)]
               (|> where
-                  (update@ #;column (function [column] ($_ n.+ column <extra> length))))])))]
+                  (update@ #;column (|>. ($_ n.+ <extra> length))))])))]
 
   [symbol^ #;SymbolS ident^                         +0]
   [tag^    #;TagS    (l;after (l;char #"#") ident^) +1]
@@ -324,19 +328,18 @@
 (def: #export (ast^ where)
   (-> Cursor (Lexer [AST Cursor]))
   (do Monad<Lexer>
-    [[_ where] (l;either (space^ where)
-                         (comment^ where))]
+    [where (padding^ where)]
     ($_ l;either
+        (form^ where ast^)
+        (tuple^ where ast^)
+        (record^ where ast^)
         (bool^ where)
         (nat^ where)
         (real^ where)
         (int^ where)
         (deg^ where)
-        (char^ where)
-        (text^ where)
         (symbol^ where)
         (tag^ where)
-        (form^ where ast^)
-        (tuple^ where ast^)
-        (record^ where ast^)
+        (char^ where)
+        (text^ where)
         )))
diff --git a/new-luxc/test/test/luxc/parser.lux b/new-luxc/test/test/luxc/parser.lux
index d6b420660..32aad3b8f 100644
--- a/new-luxc/test/test/luxc/parser.lux
+++ b/new-luxc/test/test/luxc/parser.lux
@@ -3,11 +3,12 @@
   (lux [io]
        (control monad
                 pipe)
-       (data [char]
+       (data [char "C/" Eq<Char>]
              [text "T/" Eq<Text>]
              (text format
                    ["l" lexer])
-             [number])
+             [number]
+             (coll [list]))
        ["R" math/random "R/" Monad<Random>]
        (macro [ast])
        test)
@@ -30,7 +31,7 @@
                         (R;filter (function [sample]
                                     (not (text;contains? (char;as-text sample)
                                                          invalid-range)))))]
-     size (|> R;nat (:: @ map (n.% +20)))]
+     size (|> R;nat (:: @ map (|>. (n.% +20) (n.max +1))))]
     (R;text' char-gen size)))
 
 (def: ident^
@@ -39,30 +40,36 @@
 
 (def: ast^
   (R;Random AST)
-  (let [simple^ (: (R;Random AST)
+  (let [numeric^ (: (R;Random AST)
+                    ($_ R;either
+                        (|> R;bool (R/map (|>. #;BoolS [default-cursor])))
+                        (|> R;nat (R/map (|>. #;NatS [default-cursor])))
+                        (|> R;int (R/map (|>. #;IntS [default-cursor])))
+                        (|> R;deg (R/map (|>. #;DegS [default-cursor])))
+                        (|> R;real (R/map (|>. #;RealS [default-cursor])))))
+        textual^ (: (R;Random AST)
+                    ($_ R;either
+                        (|> R;char (R/map (|>. #;CharS [default-cursor])))
+                        (do R;Monad<Random>
+                          [size (|> R;nat (R/map (n.% +20)))]
+                          (|> (R;text size) (R/map (|>. #;TextS [default-cursor]))))
+                        (|> ident^ (R/map (|>. #;SymbolS [default-cursor])))
+                        (|> ident^ (R/map (|>. #;TagS [default-cursor])))))
+        simple^ (: (R;Random AST)
                    ($_ R;either
-                       (|> R;bool (R/map (|>. #;BoolS [default-cursor])))
-                       (|> R;nat (R/map (|>. #;NatS [default-cursor])))
-                       (|> R;int (R/map (|>. #;IntS [default-cursor])))
-                       (|> R;deg (R/map (|>. #;DegS [default-cursor])))
-                       (|> R;real (R/map (|>. #;RealS [default-cursor])))
-                       (|> R;char (R/map (|>. #;CharS [default-cursor])))
-                       (do R;Monad<Random>
-                         [size (|> R;nat (R/map (n.% +20)))]
-                         (|> (R;text size) (R/map (|>. #;TextS [default-cursor]))))
-                       (|> ident^ (R/map (|>. #;SymbolS [default-cursor])))
-                       (|> ident^ (R/map (|>. #;TagS [default-cursor])))))]
+                       numeric^
+                       textual^))]
     (R;rec
      (function [ast^]
        (let [multi^ (do R;Monad<Random>
-                      [size (|> R;nat (R/map (n.% +2)))]
+                      [size (|> R;nat (R/map (n.% +3)))]
                       (R;list size ast^))
              composite^ (: (R;Random AST)
                            ($_ R;either
                                (|> multi^ (R/map (|>. #;FormS [default-cursor])))
                                (|> multi^ (R/map (|>. #;TupleS [default-cursor])))
                                (do R;Monad<Random>
-                                 [size (|> R;nat (R/map (n.% +2)))]
+                                 [size (|> R;nat (R/map (n.% +3)))]
                                  (|> (R;list size (R;seq ast^ ast^))
                                      (R/map (|>. #;RecordS [default-cursor]))))))]
          (R;either simple^
@@ -79,3 +86,61 @@
                      (#;Right [parsed _])
                      (:: ast;Eq<AST> = parsed sample))
               )))
+
+(test: "Multi-line text & comments."
+  #seed +9223374029023245172
+  [#let [char-gen (|> R;char (R;filter (function [value]
+                                         (not (or (char;space? value)
+                                                  (C/= #"\"" value)
+                                                  (C/= #"\n" value))))))]
+   x char-gen
+   y char-gen
+   z char-gen
+   offset-size (|> R;nat (R/map (|>. (n.% +10) (n.max +1))))
+   #let [offset (text;join-with "" (list;repeat offset-size " "))]
+   sample ast^
+   comment (do @
+             [size (|> R;nat (R/map (n.% +20)))]
+             (R;text' char-gen size))]
+  ($_ seq
+      (assert "Can handle multi-line text."
+              (and (let [bad-match (format (char;as-text x) "\n"
+                                           (char;as-text y) "\n"
+                                           (char;as-text z))]
+                     (|> (&;ast^ default-cursor)
+                         (l;run (format "\"" bad-match "\""))
+                         (case> (#;Left error)
+                                true
+
+                                (#;Right [parsed _])
+                                false)
+                         ))
+                   (let [good-input (format (char;as-text x) "\n"
+                                            offset (char;as-text y) "\n"
+                                            offset (char;as-text z))
+                         good-output (format (char;as-text x) "\n"
+                                             (char;as-text y) "\n"
+                                             (char;as-text z))]
+                     (|> (&;ast^ (|> default-cursor
+                                     (update@ #;column (n.+ (n.dec offset-size)))))
+                         (l;run (format "\"" good-input "\""))
+                         (case> (#;Left error)
+                                false
+
+                                (#;Right [parsed _])
+                                (:: ast;Eq<AST> =
+                                    parsed
+                                    (ast;text good-output)))
+                         ))
+                   ))
+      (assert "Can handle single-line comments."
+              (|> (&;ast^ default-cursor)
+                  (l;run (format "## " comment "\n"
+                                 (ast;to-text sample)))
+                  (case> (#;Left error)
+                         false
+
+                         (#;Right [parsed _])
+                         (:: ast;Eq<AST> = parsed sample))
+                  ))
+      ))