├── .gitignore ├── Makefile ├── Readme.md ├── _oasis ├── _tags ├── configure ├── myocamlbuild.ml ├── resources ├── _keep ├── css │ └── style.css ├── index.html └── js │ ├── jquery-1.11.0.js │ └── react-0.12.js ├── setup.ml └── src ├── core.ml └── syntax ├── #META# ├── META.ab ├── ppx_react_generate_tags.ml └── ppx_react_opts.ml /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | .*.swp 3 | .merlin 4 | # Generated outputs 5 | *.native 6 | *.cfg 7 | *.xen 8 | *.map 9 | *.img 10 | *.xl 11 | static*.ml 12 | static*.mli 13 | mir-* 14 | log 15 | .DS_Store 16 | /misc 17 | resources/js/core.js 18 | setup.data 19 | setup.log 20 | ppx_react_opts.byte 21 | ppx_react_generate_tags.byte 22 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # OASIS_START 2 | # DO NOT EDIT (digest: a3c674b4239234cbbe53afe090018954) 3 | 4 | SETUP = ocaml setup.ml 5 | 6 | build: setup.data 7 | $(SETUP) -build $(BUILDFLAGS) 8 | 9 | doc: setup.data build 10 | $(SETUP) -doc $(DOCFLAGS) 11 | 12 | test: setup.data build 13 | $(SETUP) -test $(TESTFLAGS) 14 | 15 | all: 16 | $(SETUP) -all $(ALLFLAGS) 17 | 18 | install: setup.data 19 | $(SETUP) -install $(INSTALLFLAGS) 20 | 21 | uninstall: setup.data 22 | $(SETUP) -uninstall $(UNINSTALLFLAGS) 23 | 24 | reinstall: setup.data 25 | $(SETUP) -reinstall $(REINSTALLFLAGS) 26 | 27 | clean: 28 | $(SETUP) -clean $(CLEANFLAGS) 29 | 30 | distclean: 31 | $(SETUP) -distclean $(DISTCLEANFLAGS) 32 | 33 | setup.data: 34 | $(SETUP) -configure $(CONFIGUREFLAGS) 35 | 36 | configure: 37 | $(SETUP) -configure $(CONFIGUREFLAGS) 38 | 39 | .PHONY: build doc test all install uninstall reinstall clean distclean configure 40 | 41 | # OASIS_STOP 42 | -------------------------------------------------------------------------------- /Readme.md: -------------------------------------------------------------------------------- 1 | 2 | Use React.js from js_of_ocaml. 3 | -------------------------------------------------------------------------------- /_oasis: -------------------------------------------------------------------------------- 1 | OASISFormat: 0.4 2 | Name: oc-react-playground 3 | Version: 0.0.1 4 | Synopsis: jr react playground 5 | Authors: Roma Sokolov 6 | License: MIT 7 | Plugins: DevFiles (0.2) 8 | BuildTools: ocamlbuild 9 | OCamlVersion: >= 4.02 10 | 11 | PreInstallCommand: $ocamlfind install ppx_react_opts src/syntax/META 12 | PreUninstallCommand: $ocamlfind remove ppx_react_opts 13 | 14 | Executable ppx_react_opts 15 | Path: src/syntax 16 | BuildDepends: compiler-libs.common 17 | MainIs: ppx_react_opts.ml 18 | CompiledObject: byte 19 | 20 | Executable ppx_react_generate_tags 21 | Path: src/syntax 22 | Install: false 23 | BuildDepends: compiler-libs.common 24 | MainIs: ppx_react_generate_tags.ml 25 | CompiledObject: byte 26 | 27 | Executable example 28 | Path: src 29 | MainIs: core.ml 30 | Install: false 31 | CompiledObject: byte 32 | BuildTools: ocamlbuild 33 | BuildDepends: js_of_ocaml 34 | ByteOpt+: -g 35 | ByteOpt+: -ppx src/syntax/ppx_react_opts.byte -ppx src/syntax/ppx_react_generate_tags.byte 36 | 37 | 38 | PostBuildCommand: 39 | js_of_ocaml --pretty --noinline --sourcemap core.byte -o core.js 40 | mv core.js resources/js/core.js 41 | mv core.map resources/js/core.map 42 | rm -f core.byte 43 | 44 | PostCleanCommand: 45 | rm -f resources/js/core.js 46 | -------------------------------------------------------------------------------- /_tags: -------------------------------------------------------------------------------- 1 | # OASIS_START 2 | # DO NOT EDIT (digest: 330fffe2186a7a09d797580184adb42c) 3 | # Ignore VCS directories, you can use the same kind of rule outside 4 | # OASIS_START/STOP if you want to exclude directories that contains 5 | # useless stuff for the build process 6 | true: annot, bin_annot 7 | <**/.svn>: -traverse 8 | <**/.svn>: not_hygienic 9 | ".bzr": -traverse 10 | ".bzr": not_hygienic 11 | ".hg": -traverse 12 | ".hg": not_hygienic 13 | ".git": -traverse 14 | ".git": not_hygienic 15 | "_darcs": -traverse 16 | "_darcs": not_hygienic 17 | # Executable ppx_react_opts 18 | "src/syntax/ppx_react_opts.byte": package(compiler-libs.common) 19 | # Executable ppx_react_generate_tags 20 | "src/syntax/ppx_react_generate_tags.byte": package(compiler-libs.common) 21 | : package(compiler-libs.common) 22 | # Executable example 23 | "src/core.byte": oasis_executable_example_byte 24 | : oasis_executable_example_byte 25 | "src/core.byte": package(js_of_ocaml) 26 | : package(js_of_ocaml) 27 | # OASIS_STOP 28 | -------------------------------------------------------------------------------- /configure: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | # OASIS_START 4 | # DO NOT EDIT (digest: dc86c2ad450f91ca10c931b6045d0499) 5 | set -e 6 | 7 | FST=true 8 | for i in "$@"; do 9 | if $FST; then 10 | set -- 11 | FST=false 12 | fi 13 | 14 | case $i in 15 | --*=*) 16 | ARG=${i%%=*} 17 | VAL=${i##*=} 18 | set -- "$@" "$ARG" "$VAL" 19 | ;; 20 | *) 21 | set -- "$@" "$i" 22 | ;; 23 | esac 24 | done 25 | 26 | ocaml setup.ml -configure "$@" 27 | # OASIS_STOP 28 | -------------------------------------------------------------------------------- /myocamlbuild.ml: -------------------------------------------------------------------------------- 1 | (* OASIS_START *) 2 | (* DO NOT EDIT (digest: a871dd4568fbe4d2e5edcd208fc19c3e) *) 3 | module OASISGettext = struct 4 | (* # 22 "src/oasis/OASISGettext.ml" *) 5 | 6 | 7 | let ns_ str = 8 | str 9 | 10 | 11 | let s_ str = 12 | str 13 | 14 | 15 | let f_ (str: ('a, 'b, 'c, 'd) format4) = 16 | str 17 | 18 | 19 | let fn_ fmt1 fmt2 n = 20 | if n = 1 then 21 | fmt1^^"" 22 | else 23 | fmt2^^"" 24 | 25 | 26 | let init = 27 | [] 28 | 29 | 30 | end 31 | 32 | module OASISExpr = struct 33 | (* # 22 "src/oasis/OASISExpr.ml" *) 34 | 35 | 36 | 37 | 38 | 39 | open OASISGettext 40 | 41 | 42 | type test = string 43 | 44 | 45 | type flag = string 46 | 47 | 48 | type t = 49 | | EBool of bool 50 | | ENot of t 51 | | EAnd of t * t 52 | | EOr of t * t 53 | | EFlag of flag 54 | | ETest of test * string 55 | 56 | 57 | 58 | type 'a choices = (t * 'a) list 59 | 60 | 61 | let eval var_get t = 62 | let rec eval' = 63 | function 64 | | EBool b -> 65 | b 66 | 67 | | ENot e -> 68 | not (eval' e) 69 | 70 | | EAnd (e1, e2) -> 71 | (eval' e1) && (eval' e2) 72 | 73 | | EOr (e1, e2) -> 74 | (eval' e1) || (eval' e2) 75 | 76 | | EFlag nm -> 77 | let v = 78 | var_get nm 79 | in 80 | assert(v = "true" || v = "false"); 81 | (v = "true") 82 | 83 | | ETest (nm, vl) -> 84 | let v = 85 | var_get nm 86 | in 87 | (v = vl) 88 | in 89 | eval' t 90 | 91 | 92 | let choose ?printer ?name var_get lst = 93 | let rec choose_aux = 94 | function 95 | | (cond, vl) :: tl -> 96 | if eval var_get cond then 97 | vl 98 | else 99 | choose_aux tl 100 | | [] -> 101 | let str_lst = 102 | if lst = [] then 103 | s_ "" 104 | else 105 | String.concat 106 | (s_ ", ") 107 | (List.map 108 | (fun (cond, vl) -> 109 | match printer with 110 | | Some p -> p vl 111 | | None -> s_ "") 112 | lst) 113 | in 114 | match name with 115 | | Some nm -> 116 | failwith 117 | (Printf.sprintf 118 | (f_ "No result for the choice list '%s': %s") 119 | nm str_lst) 120 | | None -> 121 | failwith 122 | (Printf.sprintf 123 | (f_ "No result for a choice list: %s") 124 | str_lst) 125 | in 126 | choose_aux (List.rev lst) 127 | 128 | 129 | end 130 | 131 | 132 | # 132 "myocamlbuild.ml" 133 | module BaseEnvLight = struct 134 | (* # 22 "src/base/BaseEnvLight.ml" *) 135 | 136 | 137 | module MapString = Map.Make(String) 138 | 139 | 140 | type t = string MapString.t 141 | 142 | 143 | let default_filename = 144 | Filename.concat 145 | (Sys.getcwd ()) 146 | "setup.data" 147 | 148 | 149 | let load ?(allow_empty=false) ?(filename=default_filename) () = 150 | if Sys.file_exists filename then 151 | begin 152 | let chn = 153 | open_in_bin filename 154 | in 155 | let st = 156 | Stream.of_channel chn 157 | in 158 | let line = 159 | ref 1 160 | in 161 | let st_line = 162 | Stream.from 163 | (fun _ -> 164 | try 165 | match Stream.next st with 166 | | '\n' -> incr line; Some '\n' 167 | | c -> Some c 168 | with Stream.Failure -> None) 169 | in 170 | let lexer = 171 | Genlex.make_lexer ["="] st_line 172 | in 173 | let rec read_file mp = 174 | match Stream.npeek 3 lexer with 175 | | [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] -> 176 | Stream.junk lexer; 177 | Stream.junk lexer; 178 | Stream.junk lexer; 179 | read_file (MapString.add nm value mp) 180 | | [] -> 181 | mp 182 | | _ -> 183 | failwith 184 | (Printf.sprintf 185 | "Malformed data file '%s' line %d" 186 | filename !line) 187 | in 188 | let mp = 189 | read_file MapString.empty 190 | in 191 | close_in chn; 192 | mp 193 | end 194 | else if allow_empty then 195 | begin 196 | MapString.empty 197 | end 198 | else 199 | begin 200 | failwith 201 | (Printf.sprintf 202 | "Unable to load environment, the file '%s' doesn't exist." 203 | filename) 204 | end 205 | 206 | 207 | let rec var_expand str env = 208 | let buff = 209 | Buffer.create ((String.length str) * 2) 210 | in 211 | Buffer.add_substitute 212 | buff 213 | (fun var -> 214 | try 215 | var_expand (MapString.find var env) env 216 | with Not_found -> 217 | failwith 218 | (Printf.sprintf 219 | "No variable %s defined when trying to expand %S." 220 | var 221 | str)) 222 | str; 223 | Buffer.contents buff 224 | 225 | 226 | let var_get name env = 227 | var_expand (MapString.find name env) env 228 | 229 | 230 | let var_choose lst env = 231 | OASISExpr.choose 232 | (fun nm -> var_get nm env) 233 | lst 234 | end 235 | 236 | 237 | # 237 "myocamlbuild.ml" 238 | module MyOCamlbuildFindlib = struct 239 | (* # 22 "src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *) 240 | 241 | 242 | (** OCamlbuild extension, copied from 243 | * http://brion.inria.fr/gallium/index.php/Using_ocamlfind_with_ocamlbuild 244 | * by N. Pouillard and others 245 | * 246 | * Updated on 2009/02/28 247 | * 248 | * Modified by Sylvain Le Gall 249 | *) 250 | open Ocamlbuild_plugin 251 | 252 | type conf = 253 | { no_automatic_syntax: bool; 254 | } 255 | 256 | (* these functions are not really officially exported *) 257 | let run_and_read = 258 | Ocamlbuild_pack.My_unix.run_and_read 259 | 260 | 261 | let blank_sep_strings = 262 | Ocamlbuild_pack.Lexers.blank_sep_strings 263 | 264 | 265 | let exec_from_conf exec = 266 | let exec = 267 | let env_filename = Pathname.basename BaseEnvLight.default_filename in 268 | let env = BaseEnvLight.load ~filename:env_filename ~allow_empty:true () in 269 | try 270 | BaseEnvLight.var_get exec env 271 | with Not_found -> 272 | Printf.eprintf "W: Cannot get variable %s\n" exec; 273 | exec 274 | in 275 | let fix_win32 str = 276 | if Sys.os_type = "Win32" then begin 277 | let buff = Buffer.create (String.length str) in 278 | (* Adapt for windowsi, ocamlbuild + win32 has a hard time to handle '\\'. 279 | *) 280 | String.iter 281 | (fun c -> Buffer.add_char buff (if c = '\\' then '/' else c)) 282 | str; 283 | Buffer.contents buff 284 | end else begin 285 | str 286 | end 287 | in 288 | fix_win32 exec 289 | 290 | let split s ch = 291 | let buf = Buffer.create 13 in 292 | let x = ref [] in 293 | let flush () = 294 | x := (Buffer.contents buf) :: !x; 295 | Buffer.clear buf 296 | in 297 | String.iter 298 | (fun c -> 299 | if c = ch then 300 | flush () 301 | else 302 | Buffer.add_char buf c) 303 | s; 304 | flush (); 305 | List.rev !x 306 | 307 | 308 | let split_nl s = split s '\n' 309 | 310 | 311 | let before_space s = 312 | try 313 | String.before s (String.index s ' ') 314 | with Not_found -> s 315 | 316 | (* ocamlfind command *) 317 | let ocamlfind x = S[Sh (exec_from_conf "ocamlfind"); x] 318 | 319 | (* This lists all supported packages. *) 320 | let find_packages () = 321 | List.map before_space (split_nl & run_and_read (exec_from_conf "ocamlfind" ^ " list")) 322 | 323 | 324 | (* Mock to list available syntaxes. *) 325 | let find_syntaxes () = ["camlp4o"; "camlp4r"] 326 | 327 | 328 | let well_known_syntax = [ 329 | "camlp4.quotations.o"; 330 | "camlp4.quotations.r"; 331 | "camlp4.exceptiontracer"; 332 | "camlp4.extend"; 333 | "camlp4.foldgenerator"; 334 | "camlp4.listcomprehension"; 335 | "camlp4.locationstripper"; 336 | "camlp4.macro"; 337 | "camlp4.mapgenerator"; 338 | "camlp4.metagenerator"; 339 | "camlp4.profiler"; 340 | "camlp4.tracer" 341 | ] 342 | 343 | 344 | let dispatch conf = 345 | function 346 | | After_options -> 347 | (* By using Before_options one let command line options have an higher 348 | * priority on the contrary using After_options will guarantee to have 349 | * the higher priority override default commands by ocamlfind ones *) 350 | Options.ocamlc := ocamlfind & A"ocamlc"; 351 | Options.ocamlopt := ocamlfind & A"ocamlopt"; 352 | Options.ocamldep := ocamlfind & A"ocamldep"; 353 | Options.ocamldoc := ocamlfind & A"ocamldoc"; 354 | Options.ocamlmktop := ocamlfind & A"ocamlmktop"; 355 | Options.ocamlmklib := ocamlfind & A"ocamlmklib" 356 | 357 | | After_rules -> 358 | 359 | (* When one link an OCaml library/binary/package, one should use 360 | * -linkpkg *) 361 | flag ["ocaml"; "link"; "program"] & A"-linkpkg"; 362 | 363 | if not (conf.no_automatic_syntax) then begin 364 | (* For each ocamlfind package one inject the -package option when 365 | * compiling, computing dependencies, generating documentation and 366 | * linking. *) 367 | List.iter 368 | begin fun pkg -> 369 | let base_args = [A"-package"; A pkg] in 370 | (* TODO: consider how to really choose camlp4o or camlp4r. *) 371 | let syn_args = [A"-syntax"; A "camlp4o"] in 372 | let (args, pargs) = 373 | (* Heuristic to identify syntax extensions: whether they end in 374 | ".syntax"; some might not. 375 | *) 376 | if Filename.check_suffix pkg "syntax" || 377 | List.mem pkg well_known_syntax then 378 | (syn_args @ base_args, syn_args) 379 | else 380 | (base_args, []) 381 | in 382 | flag ["ocaml"; "compile"; "pkg_"^pkg] & S args; 383 | flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S args; 384 | flag ["ocaml"; "doc"; "pkg_"^pkg] & S args; 385 | flag ["ocaml"; "link"; "pkg_"^pkg] & S base_args; 386 | flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S args; 387 | 388 | (* TODO: Check if this is allowed for OCaml < 3.12.1 *) 389 | flag ["ocaml"; "compile"; "package("^pkg^")"] & S pargs; 390 | flag ["ocaml"; "ocamldep"; "package("^pkg^")"] & S pargs; 391 | flag ["ocaml"; "doc"; "package("^pkg^")"] & S pargs; 392 | flag ["ocaml"; "infer_interface"; "package("^pkg^")"] & S pargs; 393 | end 394 | (find_packages ()); 395 | end; 396 | 397 | (* Like -package but for extensions syntax. Morover -syntax is useless 398 | * when linking. *) 399 | List.iter begin fun syntax -> 400 | flag ["ocaml"; "compile"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; 401 | flag ["ocaml"; "ocamldep"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; 402 | flag ["ocaml"; "doc"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; 403 | flag ["ocaml"; "infer_interface"; "syntax_"^syntax] & 404 | S[A"-syntax"; A syntax]; 405 | end (find_syntaxes ()); 406 | 407 | (* The default "thread" tag is not compatible with ocamlfind. 408 | * Indeed, the default rules add the "threads.cma" or "threads.cmxa" 409 | * options when using this tag. When using the "-linkpkg" option with 410 | * ocamlfind, this module will then be added twice on the command line. 411 | * 412 | * To solve this, one approach is to add the "-thread" option when using 413 | * the "threads" package using the previous plugin. 414 | *) 415 | flag ["ocaml"; "pkg_threads"; "compile"] (S[A "-thread"]); 416 | flag ["ocaml"; "pkg_threads"; "doc"] (S[A "-I"; A "+threads"]); 417 | flag ["ocaml"; "pkg_threads"; "link"] (S[A "-thread"]); 418 | flag ["ocaml"; "pkg_threads"; "infer_interface"] (S[A "-thread"]); 419 | flag ["ocaml"; "package(threads)"; "compile"] (S[A "-thread"]); 420 | flag ["ocaml"; "package(threads)"; "doc"] (S[A "-I"; A "+threads"]); 421 | flag ["ocaml"; "package(threads)"; "link"] (S[A "-thread"]); 422 | flag ["ocaml"; "package(threads)"; "infer_interface"] (S[A "-thread"]); 423 | 424 | | _ -> 425 | () 426 | end 427 | 428 | module MyOCamlbuildBase = struct 429 | (* # 22 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *) 430 | 431 | 432 | (** Base functions for writing myocamlbuild.ml 433 | @author Sylvain Le Gall 434 | *) 435 | 436 | 437 | 438 | 439 | 440 | open Ocamlbuild_plugin 441 | module OC = Ocamlbuild_pack.Ocaml_compiler 442 | 443 | 444 | type dir = string 445 | type file = string 446 | type name = string 447 | type tag = string 448 | 449 | 450 | (* # 62 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *) 451 | 452 | 453 | type t = 454 | { 455 | lib_ocaml: (name * dir list * string list) list; 456 | lib_c: (name * dir * file list) list; 457 | flags: (tag list * (spec OASISExpr.choices)) list; 458 | (* Replace the 'dir: include' from _tags by a precise interdepends in 459 | * directory. 460 | *) 461 | includes: (dir * dir list) list; 462 | } 463 | 464 | 465 | let env_filename = 466 | Pathname.basename 467 | BaseEnvLight.default_filename 468 | 469 | 470 | let dispatch_combine lst = 471 | fun e -> 472 | List.iter 473 | (fun dispatch -> dispatch e) 474 | lst 475 | 476 | 477 | let tag_libstubs nm = 478 | "use_lib"^nm^"_stubs" 479 | 480 | 481 | let nm_libstubs nm = 482 | nm^"_stubs" 483 | 484 | 485 | let dispatch t e = 486 | let env = 487 | BaseEnvLight.load 488 | ~filename:env_filename 489 | ~allow_empty:true 490 | () 491 | in 492 | match e with 493 | | Before_options -> 494 | let no_trailing_dot s = 495 | if String.length s >= 1 && s.[0] = '.' then 496 | String.sub s 1 ((String.length s) - 1) 497 | else 498 | s 499 | in 500 | List.iter 501 | (fun (opt, var) -> 502 | try 503 | opt := no_trailing_dot (BaseEnvLight.var_get var env) 504 | with Not_found -> 505 | Printf.eprintf "W: Cannot get variable %s\n" var) 506 | [ 507 | Options.ext_obj, "ext_obj"; 508 | Options.ext_lib, "ext_lib"; 509 | Options.ext_dll, "ext_dll"; 510 | ] 511 | 512 | | After_rules -> 513 | (* Declare OCaml libraries *) 514 | List.iter 515 | (function 516 | | nm, [], intf_modules -> 517 | ocaml_lib nm; 518 | let cmis = 519 | List.map (fun m -> (String.uncapitalize m) ^ ".cmi") 520 | intf_modules in 521 | dep ["ocaml"; "link"; "library"; "file:"^nm^".cma"] cmis 522 | | nm, dir :: tl, intf_modules -> 523 | ocaml_lib ~dir:dir (dir^"/"^nm); 524 | List.iter 525 | (fun dir -> 526 | List.iter 527 | (fun str -> 528 | flag ["ocaml"; "use_"^nm; str] (S[A"-I"; P dir])) 529 | ["compile"; "infer_interface"; "doc"]) 530 | tl; 531 | let cmis = 532 | List.map (fun m -> dir^"/"^(String.uncapitalize m)^".cmi") 533 | intf_modules in 534 | dep ["ocaml"; "link"; "library"; "file:"^dir^"/"^nm^".cma"] 535 | cmis) 536 | t.lib_ocaml; 537 | 538 | (* Declare directories dependencies, replace "include" in _tags. *) 539 | List.iter 540 | (fun (dir, include_dirs) -> 541 | Pathname.define_context dir include_dirs) 542 | t.includes; 543 | 544 | (* Declare C libraries *) 545 | List.iter 546 | (fun (lib, dir, headers) -> 547 | (* Handle C part of library *) 548 | flag ["link"; "library"; "ocaml"; "byte"; tag_libstubs lib] 549 | (S[A"-dllib"; A("-l"^(nm_libstubs lib)); A"-cclib"; 550 | A("-l"^(nm_libstubs lib))]); 551 | 552 | flag ["link"; "library"; "ocaml"; "native"; tag_libstubs lib] 553 | (S[A"-cclib"; A("-l"^(nm_libstubs lib))]); 554 | 555 | flag ["link"; "program"; "ocaml"; "byte"; tag_libstubs lib] 556 | (S[A"-dllib"; A("dll"^(nm_libstubs lib))]); 557 | 558 | (* When ocaml link something that use the C library, then one 559 | need that file to be up to date. 560 | This holds both for programs and for libraries. 561 | *) 562 | dep ["link"; "ocaml"; tag_libstubs lib] 563 | [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)]; 564 | 565 | dep ["compile"; "ocaml"; tag_libstubs lib] 566 | [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)]; 567 | 568 | (* TODO: be more specific about what depends on headers *) 569 | (* Depends on .h files *) 570 | dep ["compile"; "c"] 571 | headers; 572 | 573 | (* Setup search path for lib *) 574 | flag ["link"; "ocaml"; "use_"^lib] 575 | (S[A"-I"; P(dir)]); 576 | ) 577 | t.lib_c; 578 | 579 | (* Add flags *) 580 | List.iter 581 | (fun (tags, cond_specs) -> 582 | let spec = BaseEnvLight.var_choose cond_specs env in 583 | let rec eval_specs = 584 | function 585 | | S lst -> S (List.map eval_specs lst) 586 | | A str -> A (BaseEnvLight.var_expand str env) 587 | | spec -> spec 588 | in 589 | flag tags & (eval_specs spec)) 590 | t.flags 591 | | _ -> 592 | () 593 | 594 | 595 | let dispatch_default conf t = 596 | dispatch_combine 597 | [ 598 | dispatch t; 599 | MyOCamlbuildFindlib.dispatch conf; 600 | ] 601 | 602 | 603 | end 604 | 605 | 606 | # 606 "myocamlbuild.ml" 607 | open Ocamlbuild_plugin;; 608 | let package_default = 609 | { 610 | MyOCamlbuildBase.lib_ocaml = []; 611 | lib_c = []; 612 | flags = 613 | [ 614 | (["oasis_executable_example_byte"; "ocaml"; "link"; "byte"], 615 | [ 616 | (OASISExpr.EBool true, 617 | S 618 | [ 619 | A "-g"; 620 | A "-ppx"; 621 | A "src/syntax/ppx_react_opts.byte"; 622 | A "-ppx"; 623 | A "src/syntax/ppx_react_generate_tags.byte" 624 | ]) 625 | ]); 626 | (["oasis_executable_example_byte"; "ocaml"; "ocamldep"; "byte"], 627 | [ 628 | (OASISExpr.EBool true, 629 | S 630 | [ 631 | A "-g"; 632 | A "-ppx"; 633 | A "src/syntax/ppx_react_opts.byte"; 634 | A "-ppx"; 635 | A "src/syntax/ppx_react_generate_tags.byte" 636 | ]) 637 | ]); 638 | (["oasis_executable_example_byte"; "ocaml"; "compile"; "byte"], 639 | [ 640 | (OASISExpr.EBool true, 641 | S 642 | [ 643 | A "-g"; 644 | A "-ppx"; 645 | A "src/syntax/ppx_react_opts.byte"; 646 | A "-ppx"; 647 | A "src/syntax/ppx_react_generate_tags.byte" 648 | ]) 649 | ]) 650 | ]; 651 | includes = [] 652 | } 653 | ;; 654 | 655 | let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false} 656 | 657 | let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;; 658 | 659 | # 660 "myocamlbuild.ml" 660 | (* OASIS_STOP *) 661 | Ocamlbuild_plugin.dispatch dispatch_default;; 662 | -------------------------------------------------------------------------------- /resources/_keep: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/little-arhat/ocaml-fb-react-playground/5b66d6bd3041af1f9bdd97603cf6b271db720e6b/resources/_keep -------------------------------------------------------------------------------- /resources/css/style.css: -------------------------------------------------------------------------------- 1 | 2 | .ar_box { 3 | display: inline-block; 4 | position: relative; 5 | /* move width to other class? */ 6 | min-width:7em; 7 | width:9%; /* fallback */ 8 | width:9vw; 9 | background-color: pink; /* for debug */ 10 | margin:0.25em; 11 | } 12 | .dummy-cell { 13 | padding-top: 100%; 14 | } 15 | .element-cell { 16 | position: absolute; 17 | top: 0; 18 | bottom: 0; 19 | left: 0; 20 | right: 0; 21 | padding:0.5em; 22 | } 23 | -------------------------------------------------------------------------------- /resources/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 |
8 |
9 | 10 | 11 | 12 | 13 | -------------------------------------------------------------------------------- /setup.ml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/little-arhat/ocaml-fb-react-playground/5b66d6bd3041af1f9bdd97603cf6b271db720e6b/setup.ml -------------------------------------------------------------------------------- /src/core.ml: -------------------------------------------------------------------------------- 1 | 2 | module Html = Dom_html 3 | 4 | 5 | let to_obj l = Js.Unsafe.obj @@ Array.of_list l 6 | let jss s = Js.string s 7 | let inj o = Js.Unsafe.inject o 8 | 9 | (* Future plans: *) 10 | (* - Use experimental ppx ext for js_of_ocaml for typed access *) 11 | (* - Implement react tutorial *) 12 | (* - Implement snake game *) 13 | (* - Define ppx-deriving plugin for marshalling records to js objects *) 14 | (* - Remove Options and use objects instead *) 15 | (* - Generate object from [%opts ] extension with props and method _to_js *) 16 | 17 | module type OPTIONS = sig 18 | type t 19 | type el 20 | 21 | val empty : t 22 | val (<|) : t -> el -> t 23 | val to_js : t -> 'a 24 | 25 | val int : string -> int -> el 26 | val int32 : string -> int32 -> el 27 | val int64 : string -> int64 -> el 28 | val nativeint : string -> nativeint -> el 29 | val float : string -> float -> el 30 | val str : string -> string -> el 31 | val bool : string -> bool -> el 32 | val char : string -> char -> el 33 | val list : string -> el list -> el 34 | val array : string -> el array -> el 35 | val opts : string -> t -> el 36 | val clb : string -> (('b #Dom.event as 'a) Js.t -> bool Js.t) -> el 37 | val func : string -> ('a Js.t -> 'b Js.t) -> el 38 | 39 | end 40 | 41 | module Options:OPTIONS = struct 42 | type el = (string * Js.Unsafe.any) 43 | type t = el list 44 | 45 | let empty = [] 46 | let (<|) o p = p :: o 47 | let to_js o = Js.Unsafe.obj @@ Array.of_list o 48 | 49 | let int k v = (k, inj @@ Js.number_of_float @@ float_of_int v) 50 | let int32 k v = (k, inj @@ Js.number_of_float @@ Int32.to_float v) 51 | let int64 k v = (k, inj @@ Js.number_of_float @@ Int64.to_float v) 52 | let nativeint k v = (k, inj @@ Js.number_of_float @@ Nativeint.to_float v) 53 | let float k v = (k, inj @@ Js.number_of_float v) 54 | let str k v = (k, inj @@ Js.string v) 55 | let bool k v = (k, inj @@ Js.bool v) 56 | let char k v = (k, inj @@ Js.string @@ Char.escaped v) 57 | let list k v = (k, inj @@ Js.array @@ Array.of_list v) 58 | let array k v = (k, inj @@ Js.array v) 59 | let opts k v = (k, inj @@ to_obj v) 60 | let clb k v = (k, inj @@ Dom.handler v) 61 | let func k v = (k, inj v) 62 | end 63 | 64 | module ReactTypes = struct 65 | (* Want to hide impl details *) 66 | type component = Js.Unsafe.any 67 | end 68 | 69 | module type REACT_TYPES = sig 70 | type component = ReactTypes.component 71 | end 72 | 73 | module type COMPONENT = sig 74 | type arg 75 | type jsval 76 | val to_js : arg -> jsval 77 | val from_js : jsval -> arg 78 | val render : arg -> ReactTypes.component 79 | end 80 | 81 | module type REACT = sig 82 | include REACT_TYPES 83 | type child 84 | val tag : string -> (* tag *) 85 | Options.t -> 86 | child list -> 87 | child 88 | val text : string -> child 89 | val component : component -> child 90 | val dom : child -> component 91 | val render : component -> Dom_html.element Js.t -> unit 92 | 93 | val defcomponent : (module COMPONENT with type arg = 'a) -> ('a -> component) 94 | end 95 | 96 | module React:REACT = struct 97 | include ReactTypes 98 | type child = TextContent of string | Component of component 99 | 100 | let react = (Js.Unsafe.variable "React") 101 | 102 | let create_class renderer = 103 | let comp_opts = to_obj [("render", 104 | inj @@ Js.wrap_meth_callback renderer)] in 105 | Js.Unsafe.meth_call react "createClass" [| comp_opts |] 106 | 107 | let make_component comp opts = 108 | Js.Unsafe.meth_call react "createElement" [| comp; to_obj opts |] 109 | 110 | (* public: *) 111 | let text st = TextContent(st) 112 | let component c = Component(c) 113 | 114 | let tag tag opts children = 115 | let children_ar = Array.of_list @@ List.map 116 | (fun child -> 117 | match child with 118 | | TextContent(st) -> inj @@ jss st 119 | | Component(comp) -> inj comp) 120 | children in 121 | let js_opts = Options.to_js opts in 122 | let args = Array.append [| inj @@ jss tag; js_opts |] children_ar in 123 | Component(Js.Unsafe.meth_call react "createElement" args) 124 | 125 | let rec dom ch = match ch with 126 | | TextContent(st) -> dom @@ tag "span" [%opts] [ch] 127 | | Component(c) -> c 128 | 129 | let defcomponent (type a) (module Comp:COMPONENT with type arg = a) = 130 | let render_callback this _ = 131 | let props = Js.Unsafe.get this "props" in 132 | let value = Js.Unsafe.get props "value" in 133 | let value' = Comp.from_js value in 134 | Comp.render value' 135 | in 136 | let comp_class = create_class render_callback in 137 | let r value = 138 | make_component comp_class [("value", inj @@ Comp.to_js value)] 139 | in r 140 | 141 | let render comp node = 142 | Js.Unsafe.meth_call react "render" [| inj comp; inj node |] 143 | end 144 | 145 | module React_DOM = struct 146 | [%generate_tags 147 | a; abbr; address; area; article; aside; audio; b; base; 148 | bdi; bdo; big; blockquote; body; br; button; canvas; 149 | caption; cite; code; col; colgroup; data; datalist; dd; 150 | del; details; dfn; div; dl; dt; em; embed; fieldset; 151 | figcaption; figure; footer; form; h1; h2; h3; h4; h5; h6; 152 | head; header; hr; i; iframe; img; input; ins; kbd; 153 | keygen; label; legend; li; link; main; map; mark; menu; 154 | menuitem; meta; meter; nav; noscript; object_; ol; optgroup; 155 | option; output; p; param; pre; progress; q; rp; rt; ruby; 156 | s; samp; script; section; select; small; source; span; 157 | strong; style; sub; summary; sup; table; tbody; td; 158 | textarea; tfoot; th; thead; time; title; tr; track; 159 | u; ul; var; video; wbr; circle; g; line; path; polygon; 160 | polyline; rect; svg; text; end_] 161 | end 162 | 163 | module StringComponent = struct 164 | type arg = string 165 | type jsval = Js.js_string Js.t 166 | let from_js jsv = Js.to_string jsv 167 | let to_js ov = jss ov 168 | end 169 | 170 | module CommentList = struct 171 | include StringComponent 172 | let render prop = 173 | React_DOM.(React.dom @@ 174 | (div [%opts className="commentList"] 175 | [ 176 | React.text prop 177 | ])) 178 | end 179 | let comment_list = React.defcomponent (module CommentList) 180 | 181 | module CommentForm = struct 182 | include StringComponent 183 | let render prop = 184 | React_DOM.(React.dom @@ 185 | (div [%opts className="commentForm"] 186 | [ 187 | React.text prop 188 | ])) 189 | end 190 | let comment_form = React.defcomponent (module CommentForm) 191 | 192 | let log s = 193 | Js.Unsafe.meth_call Firebug.console "log" [| Js.Unsafe.inject (Js.string s) |] 194 | 195 | module CommentBox = struct 196 | include StringComponent 197 | let render prop = 198 | React_DOM.(React.dom @@ 199 | (div [%opts className="commentBox"] 200 | [ 201 | (h1 [%opts id="mmmm"; 202 | onClick=(fun _ -> let () = log "lol" in Js._false)] 203 | [React.text "Comment:"]); 204 | React.component @@ comment_list "This is comment list"; 205 | React.component @@ comment_form "This is comment form" 206 | ])) 207 | end 208 | let comment_box = React.defcomponent (module CommentBox) 209 | 210 | 211 | let start t = 212 | let div = Dom_html.getElementById "main-area" in 213 | let () = React.render (comment_box "This is a comment box") div in 214 | Js._false 215 | 216 | 217 | (* let () = *) 218 | (* Html.window##onload <- Dom.handler start *) 219 | 220 | (* XXX: Use hand-written expansion of above expr in the absence of camlp4 *) 221 | let () = 222 | let _ = 223 | let module M = 224 | struct 225 | let res = 226 | let _ = (Html.window : 'B Js.t) in 227 | let _ = 228 | fun (x : 'B) -> (x#onload : < set : 'A -> unit; .. > Js.gen_prop) 229 | in (Dom.handler start : 'A) 230 | 231 | end 232 | in M.res 233 | in 234 | Js.Unsafe.set Html.window "onload" (Dom.handler start) 235 | -------------------------------------------------------------------------------- /src/syntax/#META#: -------------------------------------------------------------------------------- 1 | 2 | -------------------------------------------------------------------------------- /src/syntax/META.ab: -------------------------------------------------------------------------------- 1 | version = "0.0.1" 2 | ppx = "ppx_react_opts" 3 | -------------------------------------------------------------------------------- /src/syntax/ppx_react_generate_tags.ml: -------------------------------------------------------------------------------- 1 | 2 | open Ast_mapper 3 | open Ast_helper 4 | open Asttypes 5 | open Parsetree 6 | open Longident 7 | 8 | let const_string st = 9 | Exp.constant (Const_string (st, None)) 10 | 11 | let args exprs = 12 | List.map (fun exp -> ("", exp)) exprs 13 | 14 | let ident ?(loc = !default_loc) ?left name = 15 | let n = match left with 16 | | Some(l) -> Ldot (Lident l, name) 17 | | None -> Lident name 18 | in 19 | Exp.ident { txt = n; loc } 20 | 21 | let apply id exprs = Exp.apply id (args exprs) 22 | 23 | 24 | let endswith s char = 25 | String.get s (String.length s - 1) = char 26 | 27 | let func_from_tag ?(loc = !default_loc) t = 28 | let tag_name = if endswith t '_' 29 | then String.sub t 0 (String.length t - 1) 30 | else t 31 | in 32 | let func_name = Pat.var {txt = t; loc} in 33 | let func_body = apply (ident ~loc ~left:"React" "tag") 34 | [const_string tag_name] in 35 | let bindings = Vb.mk func_name func_body in 36 | Str.value Nonrecursive [bindings] 37 | 38 | 39 | let generate_tags_mapper argv = 40 | let tags_expr mapper expr = 41 | let tag_expr mapper expr = match expr.pexp_desc with 42 | | Pexp_ident({txt = Lident t}) -> 43 | func_from_tag t 44 | | _ -> Location.raise_errorf "[%%generate_tags items should be tag names: a; br]" 45 | in 46 | let rec wrk mapper expr acc = match expr.pexp_desc with 47 | | Pexp_ident(_) -> 48 | (tag_expr mapper expr)::acc 49 | | Pexp_sequence(exp1, exp2) -> 50 | (tag_expr mapper exp1)::(wrk mapper exp2 acc) 51 | | _ -> Location.raise_errorf "[%%generate_tags] should contain sequence of tag names: a;br" 52 | in List.rev @@ wrk mapper expr [] 53 | in 54 | let generate_tags_expr mapper expr = match expr.pexp_desc with 55 | | Pexp_extension({txt = "generate_tags"; loc }, PStr(tags)) -> 56 | (match tags with 57 | | [{ pstr_desc=Pstr_eval(tags, _)}] -> 58 | tags_expr mapper tags 59 | | _ -> Location.raise_errorf ~loc "[%%opts] should contain sequence of tags to generate" 60 | ) 61 | | _ -> let () = print_string "dwdwf\n"in 62 | Location.raise_errorf "[%%opts] should contain sequence of tags to generate" 63 | in 64 | let structure mapper items = 65 | match items with 66 | | { pstr_desc = 67 | Pstr_eval({pexp_desc = 68 | Pexp_extension({txt = "generate_tags"; loc }, 69 | _)} as expr, 70 | _); 71 | pstr_loc } as item :: rest -> 72 | let tags_defs = generate_tags_expr mapper expr in 73 | default_mapper.structure mapper (List.append tags_defs rest) 74 | | _ -> default_mapper.structure mapper items 75 | in 76 | {default_mapper with structure = structure } 77 | 78 | 79 | let () = register "opts" generate_tags_mapper 80 | -------------------------------------------------------------------------------- /src/syntax/ppx_react_opts.ml: -------------------------------------------------------------------------------- 1 | open Ast_mapper 2 | open Ast_helper 3 | open Asttypes 4 | open Parsetree 5 | open Longident 6 | 7 | 8 | let const_string st = 9 | Exp.constant (Const_string (st, None)) 10 | 11 | let args exprs = 12 | List.map (fun exp -> ("", exp)) exprs 13 | 14 | let ident ?(loc = !default_loc) ?left name = 15 | let n = match left with 16 | | Some(l) -> Ldot (Lident l, name) 17 | | None -> Lident name 18 | in 19 | Exp.ident { txt = n; loc } 20 | 21 | let apply id exprs = Exp.apply id (args exprs) 22 | 23 | let open_fresh ?(loc = !default_loc) name = 24 | Exp.open_ Fresh { txt = Lident name; loc } 25 | 26 | 27 | let types = [ 28 | "int"; "int32"; "int64"; "nativeint"; "float"; "str"; "bool"; 29 | "list"; "array"; "opts"; "char" 30 | ] 31 | 32 | let strip_attrs value_expr = 33 | {value_expr with pexp_attributes=[]} 34 | 35 | let conv_func_from_value_type value_expr = 36 | let desc_attrs = (value_expr.pexp_desc, value_expr.pexp_attributes) in 37 | match desc_attrs with 38 | | (Pexp_constant const, _) -> 39 | (match const with 40 | | Const_string(_, _) -> "str" 41 | | Const_int(_) -> "int" 42 | | Const_float(_) -> "float" 43 | | Const_int32(_) -> "int32" 44 | | Const_int64(_) -> "int64" 45 | | Const_nativeint(_) -> "nativeint" 46 | | Const_char(_) -> "char" 47 | ) 48 | | (Pexp_construct({txt = Lident("true"); loc}, None), _) -> "bool" 49 | | (Pexp_construct({txt = Lident("false"); loc}, None), _) -> "bool" 50 | | (Pexp_construct({txt = Lident("::"); loc}, _), _) -> "list" 51 | | (Pexp_array(_), _) -> "array" 52 | | (Pexp_fun(_, _, _, _), _) -> "clb" 53 | | (Pexp_function(_), _) -> "clb" 54 | | (Pexp_extension({txt = "opts"; _}, _), _) -> "opts" 55 | | (Pexp_ident({txt; loc}), attrs) -> 56 | (match attrs with 57 | | [] -> "str" 58 | | [({ txt; _ }, _)] -> ( 59 | if List.mem txt types 60 | then txt 61 | else 62 | Location.raise_errorf ~loc "Unknown type:%s in type conversion attribute" txt 63 | ) 64 | | _ -> Location.raise_errorf ~loc "Option values can only have one type attribute" 65 | ) 66 | | _ -> "str" 67 | 68 | let rec opts_expr mapper expr = match expr.pexp_desc with 69 | | Pexp_extension({txt = "opts"; loc }, PStr(items)) -> 70 | (match items with 71 | | [] -> ident ~loc ~left:"Options" "empty" 72 | | [{ pstr_desc=Pstr_eval(options, _)}] -> 73 | let rev_exprs = option_expr mapper options in 74 | let application = List.fold_left 75 | (fun apl exp -> 76 | apply (ident ~loc "<|") [apl; exp]) 77 | (ident ~loc "empty") 78 | rev_exprs in 79 | open_fresh "Options" @@ application 80 | | _ -> Location.raise_errorf ~loc "[%%opts] should be empty or contain sequence k/v pairs: k1=v1; k2=v2" 81 | ) 82 | | _ -> default_mapper.expr mapper expr 83 | and option_expr mapper expr = 84 | let item_expr mapper expr = match expr.pexp_desc with 85 | | Pexp_apply({pexp_desc = Pexp_ident {txt = Lident "="}}, 86 | [("", {pexp_desc = Pexp_ident({txt = Lident key})}); 87 | ("", value_expr) 88 | ] 89 | ) -> 90 | let conv_func = conv_func_from_value_type value_expr in 91 | apply (ident conv_func) 92 | [const_string key; 93 | opts_expr mapper @@ strip_attrs value_expr] 94 | | _ -> Location.raise_errorf "[%%opts items should be key-value pairs: k=v;]" 95 | in 96 | let rec wrk mapper expr acc = match expr.pexp_desc with 97 | | Pexp_apply(_, _) -> 98 | (item_expr mapper expr)::acc 99 | | Pexp_sequence(exp1, exp2) -> 100 | (item_expr mapper exp1)::(wrk mapper exp2 acc) 101 | | _ -> Location.raise_errorf "[%%opts] should be empty or contain sequence k/v pairs: k1=v1; k2=v2" 102 | in wrk mapper expr [] 103 | 104 | let opts_mapper argv = 105 | {default_mapper with expr = opts_expr } 106 | 107 | let () = register "opts" opts_mapper 108 | --------------------------------------------------------------------------------