48bad63d9643 — orbitz NA 8 years ago
Merged in add-comment-replacement (pull request #2)

ADD Add support for comments
5 files changed, 107 insertions(+), 33 deletions(-)

M README.org
M src/snabela/snabela.ml
M src/snabela/snabela_lexer.ml
M test_data/foo.tmpl
M tests/snabela/test.ml
M README.org +5 -1
@@ 206,7 206,7 @@ Template:
 @name@ has a minimum age of @min_age@.
 @#?guest_list-@
   Guest list:
-  @#-guest_list-@
+  @-#guest_list-@
     @name@
   @-/guest_list-@
 @/guest_list-@

          
@@ 241,6 241,10 @@ End of the world party party has a minim
   No guests have signed up.
 #+END_EXAMPLE
 
+*** Comments
+A template can have a comments.  Comments start with ~@%~ or ~@-%~ and can
+contain any character other than ~@~.  A command ends with ~@~ or ~-@~.
+
 *** Transformers
 Any template replacement may include one or more transformers.  A transformer is
 a function which takes the value of a template and converts can perform any

          
M src/snabela/snabela.ml +19 -19
@@ 60,30 60,18 @@ module Template = struct
   let apply_trims tokens =
     let open Snabela_lexer.Token in
     let rec at acc = function
-      | String s::At ln::List::Test::Left_trim::xs ->
-        (* @#?- ... *)
-        at (Test::List::At ln::String (trim_trailing_ws s)::acc) xs
-      | String s::At ln::List::Left_trim::xs ->
-        (* @#- ... *)
-        at (List::At ln::String (trim_trailing_ws s)::acc) xs
-      | String s::At ln::Test::Left_trim::xs ->
-        (* @?- ... *)
-        at (Test::At ln::String (trim_trailing_ws s)::acc) xs
-      | String s::At ln::Neg_test::Left_trim::xs ->
-        (* @!- ... *)
-        at (Neg_test::At ln::String (trim_trailing_ws s)::acc) xs
       | String s::At ln::Left_trim::xs ->
-        (* @- ... *)
+        (* @-... *)
         at (At ln::String (trim_trailing_ws s)::acc) xs
-      | Left_trim::xs ->
-        (* ... - ... *)
-        at acc xs
+      | At ln::Left_trim::xs ->
+        (* Left trim is the first thing *)
+        at (At ln::acc) xs
       | Right_trim::At ln::String s::xs ->
         (* ... -@ ... *)
         at (At ln::acc) (String (trim_leading_ws s)::xs)
-      | Right_trim::xs ->
+      | Right_trim::At ln::xs ->
         (** ... -@ ... *)
-        at acc xs
+        at (At ln::acc) xs
       | x::xs ->
         at (x::acc) xs
       | [] ->

          
@@ 91,13 79,25 @@ module Template = struct
     in
     List.rev (at [] tokens)
 
+  let remove_comments tokens =
+    let open Snabela_lexer.Token in
+    let rec rc acc = function
+      | At _::Comment::At _::xs ->
+        rc acc xs
+      | x::xs ->
+        rc (x::acc) xs
+      | [] ->
+        acc
+    in
+    List.rev (rc [] tokens)
+
   let of_utf8_string s =
     let open CCResult.Infix in
     try
       let lexbuf = Sedlexing.Utf8.from_string s in
       Snabela_lexer.tokenize lexbuf
       >>= fun tokens ->
-      Ok (apply_trims tokens)
+      Ok (remove_comments (apply_trims tokens))
     with
       | exn ->
         Error (`Exn exn)

          
M src/snabela/snabela_lexer.ml +25 -8
@@ 11,6 11,7 @@ module Token = struct
     | Transformer of string
     | String of string
     | End_section
+    | Comment
   [@@deriving show,eq]
 
   type t = token list [@@deriving show,eq]

          
@@ 47,20 48,24 @@ let rec token ln bldr buf =
   match%sedlex buf with
     | "@@" ->
       token ln (Tb.add Escaped_at bldr) buf
-    | "@#?-" ->
-      replacement ln (Tb.add_l [At ln; List; Test; Left_trim] bldr) buf
-    | "@#-" ->
-      replacement ln (Tb.add_l [At ln; List; Left_trim] bldr) buf
+    | "@-%" ->
+      comment ln (Tb.add_l [At ln; Left_trim; Comment] bldr) buf
+    | "@%" ->
+      comment ln (Tb.add_l [At ln; Comment] bldr) buf
+    | "@-#?" ->
+      replacement ln (Tb.add_l [At ln; Left_trim; List; Test] bldr) buf
+    | "@-#" ->
+      replacement ln (Tb.add_l [At ln; Left_trim; List] bldr) buf
     | "@#?" ->
       replacement ln (Tb.add_l [At ln; List; Test] bldr) buf
     | "@#!" ->
       replacement ln (Tb.add_l [At ln; List; Neg_test] bldr) buf
     | "@#" ->
       replacement ln (Tb.add_l [At ln; List] bldr) buf
-    | "@?-" ->
-      replacement ln (Tb.add_l [At ln; Test; Left_trim] bldr)  buf
-    | "@!-" ->
-      replacement ln (Tb.add_l [At ln; Neg_test; Left_trim] bldr) buf
+    | "@-?" ->
+      replacement ln (Tb.add_l [At ln; Left_trim; Test] bldr)  buf
+    | "@-!" ->
+      replacement ln (Tb.add_l [At ln; Left_trim; Neg_test] bldr) buf
     | "@?" ->
       replacement ln (Tb.add_l [At ln; Test] bldr) buf
     | "@!" ->

          
@@ 125,6 130,18 @@ and replacement_close ln bldr buf =
       token ln (Tb.add (At ln) bldr) buf
     | _ ->
       raise (Tokenize_error (`Invalid_replacement ln))
+and comment ln bldr buf =
+  match%sedlex buf with
+    | "-@" ->
+      token ln (Tb.add_l [Right_trim; At ln] bldr) buf
+    | "@" ->
+      token ln (Tb.add (At ln) bldr) buf
+    | '\n' ->
+      comment (ln + 1) bldr buf
+    | any ->
+      comment ln bldr buf
+    | _ ->
+      assert false
 
 let tokenize s =
   try

          
M test_data/foo.tmpl +10 -2
@@ 1,8 1,14 @@ 
 @#parties-@
-@name@ has a minimum age of @min_age@ and has a $@cost | money@ cover charge.
+@name@ has a minimum age of @min_age-@
+@% This comment is between two lines that will be turned
+   into one line because of the whitespace trimming with -
+   Notice the indent in the line after after this, otherwise
+   the min_age and the word "and" would be right next to each
+   other -@
+ and has a $ @-cost | money@ cover charge.
 @#?guest_list-@
   Guest list:
-  @#-guest_list-@
+  @-#guest_list-@
     @name@
   @-/guest_list-@
 @/guest_list-@

          
@@ 10,3 16,5 @@ 
   No guests have signed up.
 @/guest_list-@
 @/parties-@
+
+Email joe.blow@@parties.com

          
M tests/snabela/test.ml +48 -3
@@ 82,7 82,7 @@ let test_tokenizer8 =
 @name@ has a minimum age of @min_age@.
 @#?guest_list-@
   Guest list:
-  @#-guest_list-@
+  @-#guest_list-@
     @name@
   @-/guest_list-@
 @/guest_list-@

          
@@ 104,7 104,7 @@ let test_tokenizer8 =
              ; String ".\n"
              ; At 3; List; Test; Key "guest_list"; Right_trim; At 3
              ; String "\n  Guest list:\n  "
-             ; At 5; List; Left_trim; Key "guest_list"; Right_trim; At 5
+             ; At 5; Left_trim; List; Key "guest_list"; Right_trim; At 5
              ; String "\n    "
              ; At 6; Key "name"; At 6
              ; String "\n  "

          
@@ 236,7 236,7 @@ let test_apply9 =
 @name@ has a minimum age of @min_age@.
 @#?guest_list-@
   Guest list:
-  @#-guest_list-@
+  @-#guest_list-@
     @name@
   @-/guest_list-@
 @/guest_list-@

          
@@ 308,6 308,17 @@ let test_apply11 =
        let applied = CCResult.get_exn (Snabela.apply compile kv) in
        assert ("Hello, Joe" = applied))
 
+let test_apply12 =
+  Oth.test
+    ~name:"Apply: Comment"
+    (fun _ ->
+       let template = "@%This is a template-@\nHello, @name@" in
+       let kv = Snabela.Kv.(Map.of_list [("name", string "foo")]) in
+       let t = CCResult.get_exn (Snabela.Template.of_utf8_string template) in
+       let compile = Snabela.of_template t [] in
+       let applied = CCResult.get_exn (Snabela.apply compile kv) in
+       assert ("Hello, foo" = applied))
+
 let test_apply_fail1 =
   Oth.test
     ~name:"Apply Fail: Missing key"

          
@@ 396,6 407,36 @@ let test_apply_fail8 =
        let ret = Snabela.apply compile kv in
        assert (ret = Error (`Missing_key ("name1", 7))))
 
+let test_apply_fail9 =
+  Oth.test
+    ~name:"Apply Fail: Comment"
+    (fun _ ->
+       let template = "@%This is a template-@\nHello, @name@" in
+       let kv = Snabela.Kv.(Map.of_list []) in
+       let t = CCResult.get_exn (Snabela.Template.of_utf8_string template) in
+       let compile = Snabela.of_template t [] in
+       let ret = Snabela.apply compile kv in
+       assert (ret = Error (`Missing_key ("name", 2))))
+
+let test_apply_fail10 =
+  Oth.test
+    ~name:"Apply Fail: More Comment"
+    (fun _ ->
+       let template = "@%This is\na template-@\nHello, @name@" in
+       let kv = Snabela.Kv.(Map.of_list []) in
+       let t = CCResult.get_exn (Snabela.Template.of_utf8_string template) in
+       let compile = Snabela.of_template t [] in
+       let ret = Snabela.apply compile kv in
+       assert (ret = Error (`Missing_key ("name", 3))))
+
+let test_apply_fail11 =
+  Oth.test
+    ~name:"Apply Fail: Malformed Comment"
+    (fun _ ->
+       let template = "@The difference between a valid comment @ and premature closed is subtle@" in
+       let t = Snabela.Template.of_utf8_string template in
+       assert (t = Error (`Invalid_replacement 1)))
+
 let test_transformer1 =
   Oth.test
     ~name:"Transformer: Capitalize"

          
@@ 453,6 494,7 @@ let test =
     ; test_apply9
     ; test_apply10
     ; test_apply11
+    ; test_apply12
     ; test_apply_fail1
     ; test_apply_fail2
     ; test_apply_fail3

          
@@ 461,6 503,9 @@ let test =
     ; test_apply_fail6
     ; test_apply_fail7
     ; test_apply_fail8
+    ; test_apply_fail9
+    ; test_apply_fail10
+    ; test_apply_fail11
     ; test_transformer1
     ; test_transformer2
     ]