# HG changeset patch # User orbitz NA # Date 1493987375 0 # Fri May 05 12:29:35 2017 +0000 # Node ID 48bad63d9643f85fe679003b762bcf79e1a281fa # Parent 076a455c48aa9270aa387be61992048e4979c01c # Parent 1a8782179be817f27d0d92a91c171e6fa0fa1ff4 Merged in add-comment-replacement (pull request #2) ADD Add support for comments diff --git a/README.org b/README.org --- a/README.org +++ b/README.org @@ -206,7 +206,7 @@ @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 @@ 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 diff --git a/src/snabela/snabela.ml b/src/snabela/snabela.ml --- a/src/snabela/snabela.ml +++ b/src/snabela/snabela.ml @@ -60,30 +60,18 @@ 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 @@ 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) diff --git a/src/snabela/snabela_lexer.ml b/src/snabela/snabela_lexer.ml --- a/src/snabela/snabela_lexer.ml +++ b/src/snabela/snabela_lexer.ml @@ -11,6 +11,7 @@ | Transformer of string | String of string | End_section + | Comment [@@deriving show,eq] type t = token list [@@deriving show,eq] @@ -47,20 +48,24 @@ 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 @@ 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 diff --git a/test_data/foo.tmpl b/test_data/foo.tmpl --- a/test_data/foo.tmpl +++ b/test_data/foo.tmpl @@ -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 diff --git a/tests/snabela/test.ml b/tests/snabela/test.ml --- a/tests/snabela/test.ml +++ b/tests/snabela/test.ml @@ -82,7 +82,7 @@ @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 @@ ; 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 @@ @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 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 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 @@ ; test_apply9 ; test_apply10 ; test_apply11 + ; test_apply12 ; test_apply_fail1 ; test_apply_fail2 ; test_apply_fail3 @@ -461,6 +503,9 @@ ; test_apply_fail6 ; test_apply_fail7 ; test_apply_fail8 + ; test_apply_fail9 + ; test_apply_fail10 + ; test_apply_fail11 ; test_transformer1 ; test_transformer2 ]