diff --git a/lib/kernel/comby_kernel.mli b/lib/kernel/comby_kernel.mli index d1ccd01..79de29c 100644 --- a/lib/kernel/comby_kernel.mli +++ b/lib/kernel/comby_kernel.mli @@ -335,9 +335,17 @@ module Matchers : sig type kind = | Value | Length + | Type | FileName | FilePath - | Type + | Lowercase + | Uppercase + | Capitalize + | Uncapitalize + | UpperCamelCase + | LowerCamelCase + | UpperSnakeCase + | LowerSnakeCase type syntax = { variable : string diff --git a/lib/kernel/matchers/template.ml b/lib/kernel/matchers/template.ml index 50f7323..f47adeb 100644 --- a/lib/kernel/matchers/template.ml +++ b/lib/kernel/matchers/template.ml @@ -76,10 +76,35 @@ module Make (Metasyntax : Types.Metasyntax.S) = struct | "type" -> Type | "file.name" -> FileName | "file.path" -> FilePath + | "lowercase" -> Lowercase + | "UPPERCASE" -> Uppercase + | "capitalize" -> Capitalize + | "uncapitalize" -> Uncapitalize + | "UpperCamelCase" -> UpperCamelCase + | "lowerCamelCase" -> LowerCamelCase + | "UPPER_SNAKE_CASE" -> UpperSnakeCase + | "lower_snake_case" -> LowerSnakeCase | _ -> failwith "invalid attribute" let attribute_access () = - char '.' *> choice [ string "length"; string "type" ] <* not_followed_by (Omega_parser_helper.alphanum) + char '.' *> choice + [ string "value" + ; string "length" + (* + ; string "type" + ; string "file.name" + ; string "file.path" + *) + ; string "lowercase" + ; string "UPPERCASE" + ; string "Capitalize" + ; string "uncapitalize" + ; string "UpperCamelCase" + ; string "lowerCamelCase" + ; string "UPPER_SNALE_CASE" + ; string "lowers_nake_case" + ] + <* not_followed_by (Omega_parser_helper.alphanum) (** Folds left to respect order of definitions in custom metasyntax for matching, where we attempt to parse in order. Note this is significant if a @@ -146,15 +171,57 @@ module Make (Metasyntax : Types.Metasyntax.S) = struct | Hole { pattern; _ } -> Buffer.add_string buf pattern); Buffer.contents buf + let camel_to_snake s = + let rec aux i = function + | [] -> [] + | ('A'..'Z' as c)::tl when i = 0 -> (Char.lowercase c)::aux (i+1) tl + | ('A'..'Z' as c)::tl when i <> 0 -> '_'::(Char.lowercase c)::aux (i+1) tl + | c::tl -> c::aux (i+1) tl + in + aux 0 (String.to_list s) + |> String.of_char_list + let substitute_kind { variable; kind; _ } env = let open Option in let length_to_string n = Format.sprintf "%d" (String.length n) in match kind with | Value -> Environment.lookup env variable | Length -> Environment.lookup env variable >>| length_to_string + | Type -> failwith "unimplemented" | FileName -> failwith "unimplemented" | FilePath -> failwith "unimplemented" - | Type -> failwith "unimplemented" + | Lowercase -> + Environment.lookup env variable + >>| String.lowercase + | Uppercase -> + Environment.lookup env variable + >>| String.uppercase + | Capitalize -> + Environment.lookup env variable + >>| String.capitalize + | Uncapitalize -> + Environment.lookup env variable + >>| String.uncapitalize + | UpperCamelCase -> + Environment.lookup env variable + >>| String.split ~on:'_' + >>| List.map ~f:String.capitalize + >>| String.concat + >>| String.capitalize + | LowerCamelCase -> + Environment.lookup env variable + >>| String.split ~on:'_' + >>| List.map ~f:String.capitalize + >>| String.concat + >>| String.uncapitalize + | UpperSnakeCase -> + Environment.lookup env variable + >>| camel_to_snake + >>| String.uppercase + | LowerSnakeCase -> + Environment.lookup env variable + >>| camel_to_snake + >>| String.lowercase let substitute template environment = let replacement_content, environment', _ = diff --git a/lib/kernel/matchers/types.ml b/lib/kernel/matchers/types.ml index 3146273..6bb75e3 100644 --- a/lib/kernel/matchers/types.ml +++ b/lib/kernel/matchers/types.ml @@ -117,9 +117,17 @@ module Template = struct type kind = | Value | Length + | Type | FileName | FilePath - | Type + | Lowercase + | Uppercase + | Capitalize + | Uncapitalize + | UpperCamelCase + | LowerCamelCase + | UpperSnakeCase + | LowerSnakeCase [@@deriving sexp] type syntax = diff --git a/test/common/dune b/test/common/dune index f03723f..77fe651 100644 --- a/test/common/dune +++ b/test/common/dune @@ -35,6 +35,7 @@ test_regex_holes test_template_constraints test_custom_metasyntax + test_rewrite_attributes ) (inline_tests) (preprocess (pps ppx_expect ppx_sexp_message ppx_deriving_yojson)) diff --git a/test/common/test_rewrite_attributes.ml b/test/common/test_rewrite_attributes.ml new file mode 100644 index 0000000..729d1de --- /dev/null +++ b/test/common/test_rewrite_attributes.ml @@ -0,0 +1,48 @@ +open Core + +open Comby_kernel +open Test_helpers + +let%expect_test "strings" = + let source = {| + LOWERCASE + uppercase + capitalize + Uncapitalize + upper_camel_case + Lower_camel_Case + upperSnakeCase + lowerSnakeCase +|} + in + run (module Matchers.Alpha.Generic) source + {| + :[[a]] + :[[b]] + :[[c]] + :[[d]] + :[[e]] + :[[f]] + :[[g]] + :[[h]] + |} + {| + :[[a]].lowercase + :[[b]].UPPERCASE + :[[c]].Capitalize + :[[d]].uncapitalize + :[[e]].UpperCamelCase + :[[f]].lowerCamelCase + :[[g]].UPPER_SNAKE_CASE + :[[h]].lower_snake_case + |}; + [%expect_exact {| + lowercase + UPPERCASE + Capitalize + uncapitalize + UpperCamelCase + lowerCamelCase + UPPER_SNAKE_CASE + lower_snake_case + |}];