├── test ├── pp.ml ├── dune ├── test.ml └── test.expected.ml ├── .gitignore ├── dune-project ├── src ├── ppx_bsx.ml ├── dune └── ppx_bsx_lib.ml ├── ppx_bsx.opam ├── LICENSE └── README.md /test/pp.ml: -------------------------------------------------------------------------------- 1 | Ppxlib.Driver.standalone () 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | _opam 3 | *.install 4 | *.merlin -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 1.9) 2 | (name ppx_bsx) 3 | -------------------------------------------------------------------------------- /src/ppx_bsx.ml: -------------------------------------------------------------------------------- 1 | let () = 2 | Ppxlib.Driver.run_as_ppx_rewriter () 3 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name ppx_bsx_lib) 3 | (public_name ppx_bsx.lib) 4 | (synopsis "ReasonReact JSX in OCaml") 5 | (modules ppx_bsx_lib) 6 | (kind ppx_rewriter) 7 | (libraries str markup ppxlib) 8 | (preprocess (pps ppxlib.metaquot))) 9 | 10 | (executable 11 | (name ppx_bsx) 12 | (public_name ppx_bsx) 13 | (modules ppx_bsx) 14 | (libraries ppx_bsx.lib)) 15 | -------------------------------------------------------------------------------- /test/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name pp) 3 | (modules pp) 4 | (libraries ppx_bsx.lib ppxlib)) 5 | 6 | (rule 7 | (targets test.actual.ml) 8 | (deps (:pp pp.exe) (:input test.ml)) 9 | (action (run ./%{pp} --impl %{input} -o %{targets}))) 10 | 11 | (alias 12 | (name runtest) 13 | (action (diff test.expected.ml test.actual.ml))) 14 | 15 | (test 16 | (name test) 17 | (modules test) 18 | (preprocess (pps ppx_bsx.lib))) 19 | -------------------------------------------------------------------------------- /ppx_bsx.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | 3 | name: "ppx_bsx" 4 | version: "2.0.0" 5 | synopsis: "ReasonReact JSX for OCaml" 6 | description: """ 7 | ReasonReact JSX v3 for OCaml, ReasonReact 0.7+ and BuckleScript 6.0+ required 8 | """ 9 | maintainer: "CHEN Xian-an " 10 | authors: "CHEN Xian-an " 11 | tags: [ "BuckleScript" "ReasonReact" "React" "JSX" ] 12 | license: "MIT" 13 | homepage: "https://github.com/cxa/ppx_bsx" 14 | dev-repo: "git+https://github.com/cxa/ppx_bsx.git" 15 | bug-reports: "https://github.com/cxa/ppx_bsx/issues" 16 | doc: "https://github.com/cxa/ppx_bsx" 17 | build: [ 18 | [ "dune" "subst" ] {pinned} 19 | [ "dune" "build" "-p" name "-j" jobs ] 20 | ] 21 | depends: [ 22 | "ocaml" { = "4.06.1" } 23 | "markup" 24 | "ppxlib" 25 | "dune" {build} 26 | ] 27 | url { 28 | src: "https://github.com/cxa/ppx_bsx/archive/2.0.0.tar.gz" 29 | } 30 | -------------------------------------------------------------------------------- /test/test.ml: -------------------------------------------------------------------------------- 1 | type el = S of string | L of el list 2 | 3 | module React = struct 4 | let string s = 5 | S s 6 | end 7 | 8 | module Foo = struct 9 | let createElement ?(a="") ?(b="") ?(children=[]) () = 10 | L ([S a; S b] |> List.append children) 11 | end 12 | 13 | let div ?(a="") ?(b="") ?(children=[]) () = 14 | L ([S a; S b] |> List.append children) 15 | 16 | let span ?(a="") ?(b="") ?(children=[]) () = 17 | L ([S a; S b] |> List.append children) 18 | 19 | let _ = 20 | let a = "foo" in 21 | let b = "bar" in 22 | let txt = React.string "baz" in 23 | let name = "bba" in 24 | [%bsx " 25 | <> 26 | 27 |
28 | "txt" 29 | "{j|你好世界|j}" 30 | "{|你好世界|}" 31 | Hello World 32 |
33 | "(React.string @@ "Hello, " ^ name)" 34 | 35 | 36 | 37 | "] 38 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2019 — Present CHEN Xian-an 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy 4 | of this software and associated documentation files (the "Software"), to deal 5 | in the Software without restriction, including without limitation the rights 6 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 7 | copies of the Software, and to permit persons to whom the Software is furnished 8 | to do so, subject to the following conditions: 9 | 10 | The above copyright notice and this permission notice shall be included in all 11 | copies or substantial portions of the Software. 12 | 13 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 14 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 15 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 16 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 17 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 18 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 19 | THE SOFTWARE. 20 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # ppx_bsx 2 | 3 | OCaml JSX for ReasonReact. 4 | 5 | ## Install 6 | 7 | `ppx_bsx` depends on `ppx_lib`, which means that `ppx_bsx` doesn't support `bs-platform` 5.x, so first step is configuring your project to `"bs-platform": "^6.0.1"`. 8 | 9 | Install `ppx_bsx` with `opam` or `esy`, and add `ppx_bsx` executable to `bs-config.json`: 10 | 11 | ```json 12 | { 13 | "ppx-flags": [ 14 | "./_opam/bin/ppx_bsx", 15 | "./node_modules/bs-platform/lib/bsppx.exe -bs-jsx 3" 16 | ] 17 | } 18 | ``` 19 | 20 | Replace `./_opam/bin/ppx_bsx` to actual `ppx_bsx` installed path. 21 | 22 | Example: https://github.com/cxa/ppx_bsx_example. 23 | 24 | ## Basic Usage 25 | 26 | This is how it feel: 27 | 28 | ```ocaml 29 | [%bsx " 30 | 31 |

Nice example

32 | 35 |
36 | "(React.string {j|这是主内容|j})" 37 |
38 | 39 | "] 40 | ``` 41 | 42 | ### Simple Rules 43 | - Break `[%bsx ""]` into 44 | ```ocaml 45 | [%bsx " 46 | 47 | "] 48 | ``` 49 | and ignore the first and last quotation marks. 50 | - When you need OCaml expression, wrap it with double quotation marks, otherwise 51 | - For string literal value, just use single quotation marks 52 | - For single text node, you don't need to wrap it to `ReasonReact.string`, (surprisedly) `Hello, World` is accepted 53 | - Single text `{|你好|}` (but not `expr {|你好|}`) will be transformed to `{j|你好|j}` automatically 54 | -------------------------------------------------------------------------------- /test/test.expected.ml: -------------------------------------------------------------------------------- 1 | type el = 2 | | S of string 3 | | L of el list 4 | module React = struct let string s = S s end 5 | module Foo = 6 | struct 7 | let createElement ?(a= "") ?(b= "") ?(children= []) () = 8 | L ([S a; S b] |> (List.append children)) 9 | end 10 | let div ?(a= "") ?(b= "") ?(children= []) () = 11 | L ([S a; S b] |> (List.append children)) 12 | let span ?(a= "") ?(b= "") ?(children= []) () = 13 | L ([S a; S b] |> (List.append children)) 14 | let _ = 15 | let a = "foo" in 16 | let b = "bar" in 17 | let txt = React.string "baz" in 18 | let name = "bba" in 19 | (([((Foo.createElement ~a ~b 20 | ~children:[((div ~a:{j|数据|j} 21 | ~children:[((span ~a ~children:[txt] ()) 22 | [@JSX ]); 23 | ((span 24 | ~children:[React.string 25 | {j|你好世界|j}] ()) 26 | [@JSX ]); 27 | ((span 28 | ~children:[React.string 29 | {j|你好世界|j}] ()) 30 | [@JSX ]); 31 | ((span 32 | ~children:[React.string "Hello World"] 33 | ()) 34 | [@JSX ])] ()) 35 | [@JSX ]); 36 | ((span ~children:[React.string @@ ("Hello, " ^ name)] ()) 37 | [@JSX ])] ()) 38 | [@JSX ]); 39 | ((span ~children:[] ()) 40 | [@JSX ])])[@JSX ]) 41 | -------------------------------------------------------------------------------- /src/ppx_bsx_lib.ml: -------------------------------------------------------------------------------- 1 | open Ppxlib 2 | 3 | module ExprsMap = Map.Make(String) 4 | 5 | type html_frags = 6 | { strs: string list 7 | ; exprs: expression ExprsMap.t 8 | } 9 | 10 | let name = "ppx_bsx" 11 | 12 | let expr_placeholder_prefix = "__b_s_x__placeholder__" 13 | 14 | let fragment_placeholder = "ppx_bsx_fragment" 15 | 16 | let tidy_attr_name = 17 | function 18 | | "class" -> "className" 19 | | "for" -> "htmlFor" 20 | | "type" -> "type_" 21 | | "to" -> "to_" 22 | | "open" -> "open_" 23 | | "begin" -> "begin_" 24 | | "end" -> "end_" 25 | | "in" -> "in_" 26 | | _ as origin -> origin 27 | 28 | let is_titlecase str = 29 | let fstc = String.get str 0 in 30 | Char.uppercase_ascii fstc = fstc 31 | 32 | let placeholderize_fragment html = 33 | Str.( 34 | html 35 | |> global_replace (regexp "<>") ("<" ^ fragment_placeholder ^ ">") 36 | |> global_replace (regexp "") ("") 37 | ) 38 | 39 | let collect_html first_html_frag expr_list = 40 | expr_list 41 | |> List.fold_left (fun (frags, placeholder_index) (_, expr) -> 42 | match expr.pexp_desc with 43 | | Pexp_constant (Pconst_string (str, None)) -> 44 | ({ frags with strs = str :: frags.strs }, placeholder_index) 45 | | _ -> 46 | let attr = Printf.sprintf "%s%i" expr_placeholder_prefix placeholder_index in 47 | ({ strs = attr :: frags.strs 48 | ; exprs = ExprsMap.add attr expr frags.exprs 49 | }, placeholder_index + 1) 50 | ) ({ strs = [first_html_frag]; exprs = ExprsMap.empty }, 0) 51 | |> fst 52 | 53 | let text_to_expr loc txts exprs = 54 | let txt = String.concat "" txts in 55 | Ast_builder.Default.( 56 | match exprs |> ExprsMap.find_opt txt with 57 | | Some expr -> 58 | begin match expr.pexp_desc with 59 | | Pexp_constant (Pconst_string (str, Some "")) -> (* transform {|w|} to {j|w|j} *) 60 | pexp_constant ~loc (Pconst_string (str, Some "j")) 61 | | _ -> expr 62 | end 63 | | None -> estring ~loc txt 64 | ) 65 | 66 | let handle_markup_text loc exprs txts = 67 | let expr = text_to_expr loc txts exprs in 68 | match expr.pexp_desc with 69 | | Pexp_constant _ -> 70 | let args = [(Nolabel, expr)] in 71 | Ast_builder.Default.pexp_apply ~loc [%expr React.string] args 72 | | _ -> expr 73 | 74 | let add_jsx_attr loc e = 75 | {e with pexp_attributes = [({txt = "JSX"; loc}, PStr [])] } 76 | 77 | let handle_markup_element loc exprs (_nsuri, lname) attrs children = 78 | let open Ast_builder.Default in 79 | match lname with 80 | | n when n = fragment_placeholder -> 81 | elist ~loc children |> add_jsx_attr loc 82 | | _ -> 83 | let is_titlecase = is_titlecase lname in 84 | let fname = 85 | if is_titlecase 86 | then Printf.sprintf "%s.createElement" lname 87 | else lname 88 | in 89 | let f = [%expr [%e evar ~loc fname]] in 90 | let labled_args = 91 | attrs 92 | |> List.map (fun ((_uri, name), v) -> 93 | let exp = 94 | if String.length v = 0 95 | then evar ~loc name 96 | else text_to_expr loc [v] exprs 97 | in 98 | ((Labelled (tidy_attr_name name)), exp) 99 | ) 100 | in 101 | let args = 102 | (Nolabel, eunit ~loc) 103 | :: (Labelled "children", elist ~loc children) 104 | :: List.rev labled_args 105 | |> List.rev 106 | in 107 | pexp_apply ~loc f args |> add_jsx_attr loc 108 | 109 | let report loc mloc error = 110 | Markup.( 111 | match error with 112 | | `Bad_token _ -> () (* ignore this error because our attrs missing quotations*) 113 | | _ -> 114 | let location = 115 | fst mloc + loc.loc_start.pos_lnum 116 | , snd mloc + loc.loc_start.pos_cnum 117 | in 118 | let errstr = Error.to_string ~location error in 119 | Location.raise_errorf ~loc "%s" errstr 120 | ) 121 | 122 | let mk_html str_list = 123 | str_list 124 | |> List.rev 125 | |> String.concat "" 126 | |> placeholderize_fragment 127 | 128 | let markupize loc html_frags = 129 | Markup.( 130 | mk_html html_frags.strs 131 | |> string 132 | |> parse_xml ~report:(report loc) 133 | |> signals 134 | |> trim 135 | |> normalize_text 136 | |> tree 137 | ~text:(handle_markup_text loc html_frags.exprs) 138 | ~element:(handle_markup_element loc html_frags.exprs) 139 | ) 140 | 141 | let expand ~loc ~path:_ expr = 142 | let first_html_frag, expr_list = 143 | match expr.pexp_desc with 144 | | Pexp_constant (Pconst_string (str, None)) -> 145 | str, [] 146 | | Pexp_apply ({ pexp_desc = Pexp_constant (Pconst_string (str, None)); _ }, exprs) -> 147 | str, exprs 148 | | _ -> Location.raise_errorf ~loc "Wrong JSX format" 149 | in 150 | let html_frags = collect_html first_html_frag expr_list in 151 | match markupize loc html_frags with 152 | | Some expr -> expr 153 | | None -> Location.raise_errorf ~loc "Wrong JSX format" 154 | 155 | let ext = 156 | Extension.declare 157 | "bsx" 158 | Extension.Context.expression 159 | Ast_pattern.(single_expr_payload __) 160 | expand 161 | 162 | let () = 163 | Driver.register_transformation name ~extensions:[ext] 164 | --------------------------------------------------------------------------------