- Added some extra text lexers.

1 files changed, 39 insertions, 24 deletions

diff --git a/stdlib/source/lux/lexer.lux b/stdlib/source/lux/lexer.lux
index bc5bea5f0..787cbb0c5 100644
--- a/stdlib/source/lux/lexer.lux
+++ b/stdlib/source/lux/lexer.lux
@@ -9,15 +9,13 @@
                 applicative
                 monad
                 codec)
-       (data [text "Text/" Eq<Text>]
-             text/format
+       (data [text "Text/" Eq<Text> Monoid<Text>]
              [number "Int/" Codec<Text,Int>]
              [product]
              [char "Char/" Ord<Char>]
              maybe
              ["E" error #- fail]
-             (struct [list "" Functor<List>]))
-       host))
+             (struct [list "" Functor<List>]))))
 
 ## [Types]
 (type: #export (Lexer a)
@@ -247,7 +245,7 @@
       (case (text;split (text;size test) input)
         #;None              (#E;Error "")
         (#;Some [_ input']) (#E;Success [input' test]))
-      (#E;Error (format "Invalid match: " test " @ " (:: text;Codec<Text,Text> encode input))))
+      (#E;Error ($_ Text/append "Invalid match: " test " @ " (:: text;Codec<Text,Text> encode input))))
     ))
 
 (def: #export (sep-by sep lexer)
@@ -271,7 +269,7 @@
   (lambda [input]
     (case input
       "" (#E;Success [input []])
-      _  (#E;Error (format "The text input has not been fully consumed @ " (:: text;Codec<Text,Text> encode input)))
+      _  (#E;Error ($_ Text/append "The text input has not been fully consumed @ " (:: text;Codec<Text,Text> encode input)))
       )))
 
 (def: #export peek
@@ -294,8 +292,7 @@
       [(#;Some char') (#;Some [_ input'])]
       (if (Char/= test char')
         (#E;Success [input' test])
-        (#E;Error (format "Expected " (:: char;Codec<Text,Char> encode test) " @ " (:: text;Codec<Text,Text> encode input)
-                          " " (Int/encode (c2l test))" " (Int/encode (c2l [char'])))))
+        (#E;Error ($_ Text/append "Expected " (:: char;Codec<Text,Char> encode test) " @ " (:: text;Codec<Text,Text> encode input))))
 
       _
       (#E;Error "Can't parse character from empty text."))
@@ -313,14 +310,14 @@
   (do Monad<Lexer>
     [input get-input
      char any
-     _ (assert (format "Character is not within range: " (:: char;Codec<Text,Char> encode bottom) "-" (:: char;Codec<Text,Char> encode top) " @ " (:: text;Codec<Text,Text> encode input))
+     _ (assert ($_ Text/append "Character is not within range: " (:: char;Codec<Text,Char> encode bottom) "-" (:: char;Codec<Text,Char> encode top) " @ " (:: text;Codec<Text,Text> encode input))
                (and (Char/>= bottom char)
                     (Char/<= top char)))]
     (wrap char)))
 
 (do-template [<name> <bottom> <top> <desc>]
   [(def: #export <name>
-     {#;doc (#;TextM (format "Only lex " <desc> " characters."))}
+     {#;doc (#;TextM ($_ Text/append "Only lex " <desc> " characters."))}
      (Lexer Char)
      (char-range <bottom> <top>))]
 
@@ -361,7 +358,7 @@
 
           _
           (#E;Error ""))
-        (#E;Error (format "Character (" init ") is not one of: " options " @ " (:: text;Codec<Text,Text> encode input))))
+        (#E;Error ($_ Text/append "Character (" init ") is not one of: " options " @ " (:: text;Codec<Text,Text> encode input))))
 
       _
       (#E;Error "Can't parse character from empty text."))))
@@ -379,7 +376,7 @@
 
           _
           (#E;Error ""))
-        (#E;Error (format "Character (" init ") is one of: " options " @ " (:: text;Codec<Text,Text> encode input))))
+        (#E;Error ($_ Text/append "Character (" init ") is one of: " options " @ " (:: text;Codec<Text,Text> encode input))))
 
       _
       (#E;Error "Can't parse character from empty text."))))
@@ -396,7 +393,7 @@
       (#;Some [input' output])
       (if (p output)
         (#E;Success [input' output])
-        (#E;Error (format "Character does not satisfy predicate: " (:: text;Codec<Text,Text> encode input))))
+        (#E;Error ($_ Text/append "Character does not satisfy predicate: " (:: text;Codec<Text,Text> encode input))))
 
       _
       (#E;Error "Can't parse character from empty text."))))
@@ -406,18 +403,36 @@
   (Lexer Char)
   (satisfies char;space?))
 
-(def: #export (some' p)
-  {#;doc "Lex some characters as a single continuous text."}
-  (-> (Lexer Char) (Lexer Text))
-  (do Monad<Lexer>
-    [cs (some p)]
-    (wrap (text;concat (map char;as-text cs)))))
+(do-template [<name> <base> <doc>]
+  [(def: #export (<name> p)
+     {#;doc <doc>}
+     (-> (Lexer Char) (Lexer Text))
+     (do Monad<Lexer>
+       [cs (<base> p)]
+       (wrap (text;concat (map char;as-text cs)))))]
+
+  [some' some "Lex some characters as a single continuous text."]
+  [many' many "Lex many characters as a single continuous text."]
+  )
+
+(do-template [<name> <base> <doc>]
+  [(def: #export (<name> n p)
+     {#;doc <doc>}
+     (-> Nat (Lexer Char) (Lexer Text))
+     (do Monad<Lexer>
+       [cs (<base> n p)]
+       (wrap (text;concat (map char;as-text cs)))))]
+
+  [exactly'  exactly  "Lex exactly N characters."]
+  [at-most'  at-most  "Lex at most N characters."]
+  [at-least' at-least "Lex at least N characters."]
+  )
 
-(def: #export (many' p)
-  {#;doc "Lex many characters as a single continuous text."}
-  (-> (Lexer Char) (Lexer Text))
+(def: #export (between' from to p)
+  {#;doc "Lex between N and M characters."}
+  (-> Nat Nat (Lexer Char) (Lexer Text))
   (do Monad<Lexer>
-    [cs (many p)]
+    [cs (between from to p)]
     (wrap (text;concat (map char;as-text cs)))))
 
 (def: #export end?
@@ -489,4 +504,4 @@
       (#E;Success [unconsumed value])
       (if (Text/= "" unconsumed)
         (#E;Success [real-input value])
-        (#E;Error (format "Unconsumed input: " unconsumed))))))
+        (#E;Error ($_ Text/append "Unconsumed input: " unconsumed))))))