2 | -------------------------------------------------------------------------------- /modularity/part1.atd: -------------------------------------------------------------------------------- 1 | type t = { x : int; y : int } 2 | -------------------------------------------------------------------------------- /hello/hello.atd: -------------------------------------------------------------------------------- 1 | type date = { 2 | year : int; 3 | month : int; 4 | day : int; 5 | } 6 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | **This tutorial is now maintained with other atdgen-related documents at 2 | https://github.com/mjambon/atdgen-doc** 3 | -------------------------------------------------------------------------------- /modularity/part3.atd: -------------------------------------------------------------------------------- 1 | type t2 = abstract 2 | 3 | type t3 = { 4 | name : string; 5 | ?data : t2 option; 6 | } 7 | -------------------------------------------------------------------------------- /pretty-json/single.json: -------------------------------------------------------------------------------- 1 | [1234,"abcde",{"start_date":{"year":1970,"month":1,"day":1}, 2 | "end_date":{"year":1980,"month":1,"day":1}}] 3 | -------------------------------------------------------------------------------- /hello/hello.ml: -------------------------------------------------------------------------------- 1 | open Hello_t 2 | let () = 3 | let date = { year = 1970; month = 1; day = 1 } in 4 | print_endline (Hello_j.string_of_date date) 5 | -------------------------------------------------------------------------------- /pretty-json/stream.json: -------------------------------------------------------------------------------- 1 | [1234,"abcde",{"start_date":{"year":1970,"month":1,"day":1}, 2 | "end_date":{"year":1980,"month":1,"day":1}}] 3 | [1,"a",{}] 4 | -------------------------------------------------------------------------------- /inspect-biniou/tree.atd: -------------------------------------------------------------------------------- 1 | (* This a binary tree. Just for the purpose of pretty-printing trees. *) 2 | type tree = 3 | [ Empty 4 | | Node of (tree * int * tree) ] 5 | 6 | -------------------------------------------------------------------------------- /pretty-json/prettify.ml: -------------------------------------------------------------------------------- 1 | let json = 2 | "[1234,\"abcde\",{\"start_date\":{\"year\":1970,\"month\":1,\"day\":1}, 3 | \"end_date\":{\"year\":1980,\"month\":1,\"day\":1}}]" 4 | 5 | let () = print_endline (Yojson.Safe.prettify json) 6 | -------------------------------------------------------------------------------- /hevea-insert1.html: -------------------------------------------------------------------------------- 1 | 11 | -------------------------------------------------------------------------------- /pretty-json/demo.sh: -------------------------------------------------------------------------------- 1 | #! /bin/sh -e 2 | 3 | set -x 4 | cat single.json 5 | ydump single.json 6 | cat stream.json 7 | ydump -s stream.json 8 | 9 | cat prettify.ml 10 | ocamlfind ocamlopt -o prettify prettify.ml -package atdgen -linkpkg 11 | ./prettify 12 | -------------------------------------------------------------------------------- /config-file/bad-config1.json: -------------------------------------------------------------------------------- 1 | { 2 | "title": "Example", 3 | "credentials": [ 4 | { 5 | "name": 0, 6 | "key": "db7c0877bdef3016" 7 | }, 8 | { 9 | "name": "tester", 10 | "key": "09871ff387ac2b10" 11 | } 12 | ] 13 | } 14 | -------------------------------------------------------------------------------- /modularity/main.ml: -------------------------------------------------------------------------------- 1 | let v = { 2 | Part3_t.name = "foo"; 3 | data = Some [ 4 | { Part1_t.x = 1; y = 2 }; 5 | { Part1_t.x = 3; y = 4 }; 6 | ] 7 | } 8 | 9 | let () = 10 | Ag_util.Json.to_channel Part3_j.write_t3 stdout v; 11 | print_newline () 12 | -------------------------------------------------------------------------------- /config-file/sample-config.json: -------------------------------------------------------------------------------- 1 | { 2 | "title": "Example", 3 | "credentials": [ 4 | { 5 | "name": "joeuser", 6 | "key": "db7c0877bdef3016" 7 | }, 8 | { 9 | "name": "tester", 10 | "key": "09871ff387ac2b10" 11 | } 12 | ] 13 | } 14 | -------------------------------------------------------------------------------- /config-file/bad-config2.json: -------------------------------------------------------------------------------- 1 | { 2 | "title": "Example", 3 | "tiemout": 20, 4 | "credentials": [ 5 | { 6 | "name": "joeuser", 7 | "key": "db7c0877bdef3016" 8 | }, 9 | { 10 | "name": "tester", 11 | "key": "09871ff387ac2b10" 12 | } 13 | ] 14 | } 15 | -------------------------------------------------------------------------------- /modularity/part2.atd: -------------------------------------------------------------------------------- 1 | type t1 = abstract 2 | (* 3 | Imports type t defined in file part1.atd. 4 | The local name is t1. Because the local name (t1) is different from the 5 | original name (t), we must specify the original name using t=. 6 | *) 7 | 8 | type t2 = t1 list 9 | -------------------------------------------------------------------------------- /inspect-biniou/demo.sh: -------------------------------------------------------------------------------- 1 | #! /bin/sh -e 2 | 3 | set -x 4 | 5 | cat tree.atd 6 | cat tree.ml 7 | 8 | atdgen -t tree.atd 9 | atdgen -b tree.atd 10 | ocamlfind ocamlopt -o tree \ 11 | tree_t.mli tree_t.ml tree_b.mli tree_b.ml tree.ml \ 12 | -package atdgen -linkpkg 13 | ./tree 14 | 15 | ls -l tree.dat 16 | bdump tree.dat 17 | bdump -w Empty,Node tree.dat 18 | bdump tree.dat 19 | -------------------------------------------------------------------------------- /validate/resume.atd: -------------------------------------------------------------------------------- 1 | type text = string 2 | 3 | type date = { 4 | year : int; 5 | month : int; 6 | day : int; 7 | } 8 | 9 | type job = { 10 | company : text; 11 | title : text; 12 | start_date : date; 13 | ?end_date : date option; 14 | } 15 | 16 | type work_experience = job list 17 | -------------------------------------------------------------------------------- /config-file/config.atd: -------------------------------------------------------------------------------- 1 | type config = { 2 | title : string; 3 | ?description : string option; 4 | ~timeout : int; 5 | ~credentials : param list 6 | ; 8 | } 9 | 10 | type param = { 11 | name : string 12 | ; 13 | key : string 14 | ; 15 | } 16 | -------------------------------------------------------------------------------- /hello/demo.sh: -------------------------------------------------------------------------------- 1 | #! /bin/sh -e 2 | 3 | set -x 4 | cat hello.atd 5 | atdgen -t hello.atd 6 | atdgen -j hello.atd 7 | ls 8 | ocamlfind ocamlc -c hello_t.mli -package atdgen 9 | ocamlfind ocamlc -c hello_j.mli -package atdgen 10 | ocamlfind ocamlopt -c hello_t.ml -package atdgen 11 | ocamlfind ocamlopt -c hello_j.ml -package atdgen 12 | ocamlfind ocamlopt -c hello.ml -package atdgen 13 | ocamlfind ocamlopt -o hello hello_t.cmx hello_j.cmx hello.cmx \ 14 | -package atdgen -linkpkg 15 | ./hello 16 | -------------------------------------------------------------------------------- /modularity/demo.sh: -------------------------------------------------------------------------------- 1 | #! /bin/sh -e 2 | 3 | set -x 4 | cat part1.atd 5 | cat part2.atd 6 | cat part3.atd 7 | for x in part1 part2 part3; do 8 | atdgen -t $x.atd 9 | atdgen -j $x.atd 10 | ocamlfind ocamlc -c ${x}_t.mli -package atdgen 11 | ocamlfind ocamlc -c ${x}_j.mli -package atdgen 12 | ocamlfind ocamlopt -c ${x}_t.ml -package atdgen 13 | ocamlfind ocamlopt -c ${x}_j.ml -package atdgen 14 | done 15 | ocamlfind ocamlopt -c main.ml -package atdgen 16 | 17 | ocamlfind ocamlopt -o test_modularity \ 18 | part1_t.cmx part1_j.cmx \ 19 | part2_t.cmx part2_j.cmx \ 20 | part3_t.cmx part3_j.cmx \ 21 | main.cmx \ 22 | -package atdgen -linkpkg 23 | ./test_modularity 24 | -------------------------------------------------------------------------------- /validate/demo.sh: -------------------------------------------------------------------------------- 1 | #! /bin/sh -e 2 | 3 | set -x 4 | cat resume.atd 5 | atdgen -t resume.atd 6 | atdgen -j resume.atd 7 | atdgen -v resume.atd 8 | ls 9 | ocamlfind ocamlc -c resume_t.mli -package atdgen 10 | ocamlfind ocamlc -c resume_v.mli -package atdgen 11 | ocamlfind ocamlc -c resume_j.mli -package atdgen 12 | ocamlfind ocamlopt -c resume_t.ml -package atdgen 13 | ocamlfind ocamlopt -c resume_util.ml -package atdgen 14 | ocamlfind ocamlopt -c resume_v.ml -package atdgen 15 | ocamlfind ocamlopt -c resume_j.ml -package atdgen 16 | ocamlfind ocamlopt -c resume.ml -package atdgen 17 | ocamlfind ocamlopt -o test_resume \ 18 | resume_t.cmx resume_util.cmx resume_v.cmx resume_j.cmx resume.cmx \ 19 | -package atdgen -linkpkg 20 | ./test_resume 21 | -------------------------------------------------------------------------------- /inspect-biniou/tree.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | 3 | (* sample value *) 4 | let tree : Tree_t.tree = 5 | `Node ( 6 | `Node (`Empty, 1, `Empty), 7 | 2, 8 | `Node ( 9 | `Node (`Empty, 3, `Empty), 10 | 4, 11 | `Node (`Empty, 5, `Empty) 12 | ) 13 | ) 14 | 15 | let () = 16 | (* write sample value to file *) 17 | let fname = "tree.dat" in 18 | Ag_util.Biniou.to_file Tree_b.write_tree fname tree; 19 | 20 | (* write sample value to string *) 21 | let s = Tree_b.string_of_tree tree in 22 | printf "raw value (saved as %s):\n%S\n" fname s; 23 | printf "length: %i\n" (String.length s); 24 | 25 | printf "pretty-printed value (without dictionary):\n"; 26 | print_endline (Bi_io.view s); 27 | 28 | printf "pretty-printed value (with dictionary):\n"; 29 | let unhash = Bi_io.make_unhash ["Empty"; "Node"; "foo"; "bar" ] in 30 | print_endline (Bi_io.view ~unhash s) 31 | -------------------------------------------------------------------------------- /config-file/demo.sh: -------------------------------------------------------------------------------- 1 | #! /bin/sh -e 2 | 3 | set -x 4 | 5 | # Embed the contents of the .atd file into our OCaml program 6 | echo 'let contents = "\' > config_atd.ml 7 | sed -e 's/$[\\"]$/\\\1/g' config.atd >> config_atd.ml 8 | echo '"' >> config_atd.ml 9 | 10 | # Derive OCaml type definitions from .atd file 11 | atdgen -t config.atd 12 | 13 | # Derive JSON-related functions from .atd file 14 | atdgen -j -j-defaults -j-strict-fields config.atd 15 | 16 | # Derive validator from .atd file 17 | atdgen -v config.atd 18 | 19 | # Compile the OCaml program 20 | ocamlfind ocamlopt -o config \ 21 | config_t.mli config_t.ml config_j.mli config_j.ml config_v.mli config_v.ml \ 22 | config_atd.ml config.ml -package atdgen -linkpkg 23 | 24 | # Output a sample config 25 | ./config -template 26 | 27 | # Print the original type definitions 28 | ./config -format 29 | 30 | # Fail to validate an invalid config file 31 | ./config -validate bad-config1.json || : 32 | 33 | # Fail to validate another invalid config file (using custom validators) 34 | ./config -validate bad-config3.json || : 35 | 36 | # Validate, inject missing defaults and pretty-print 37 | ./config -validate sample-config.json 38 | -------------------------------------------------------------------------------- /validate/resume.ml: -------------------------------------------------------------------------------- 1 | let check_experience x = 2 | (match Resume_v.validate_work_experience [] x with 3 | None -> 4 | Printf.printf "VALID:\n" 5 | | Some error -> 6 | Printf.printf "INVALID: %s\n" 7 | (Ag_util.Validation.string_of_error error) 8 | ); 9 | Printf.printf "%s\n" 10 | (Yojson.Safe.prettify (Resume_j.string_of_work_experience x)) 11 | 12 | let () = 13 | (* one valid date *) 14 | let valid = { Resume_t.year = 2000; month = 2; day = 29 } in 15 | (* one invalid date *) 16 | let invalid = { Resume_t.year = 2010; month = 0; day = 0 } in 17 | (* two more valid dates, created with Resume_v.create_date *) 18 | let date1 = { Resume_t.year = 2005; month = 8; day = 1 } in 19 | let date2 = { Resume_t.year = 2006; month = 3; day = 22 } in 20 | 21 | let job = { 22 | Resume_t.company = "Acme Corp."; 23 | title = "Tester"; 24 | start_date = date1; 25 | end_date = Some date2; 26 | } 27 | in 28 | let valid_job = { job with Resume_t.start_date = valid } in 29 | let invalid_job = { job with Resume_t.end_date = Some invalid } in 30 | let valid_experience = [ job; valid_job ] in 31 | let invalid_experience = [ job; invalid_job ] in 32 | check_experience valid_experience; 33 | check_experience invalid_experience 34 | -------------------------------------------------------------------------------- /validate/resume_util.ml: -------------------------------------------------------------------------------- 1 | open Resume_t 2 | 3 | let ascii_printable c = 4 | let n = Char.code c in 5 | n >= 32 && n <= 127 6 | 7 | (* 8 | Check that string is not empty and contains only ASCII printable 9 | characters (for the sake of the example; we use UTF-8 these days) 10 | *) 11 | let validate_some_text path s = 12 | let success = 13 | s <> "" && 14 | try 15 | String.iter (fun c -> if not (ascii_printable c) then raise Exit) s; 16 | true 17 | with Exit -> 18 | false 19 | in 20 | if success then None 21 | else 22 | Some (Ag_util.Validation.error path) 23 | 24 | (* 25 | Check that the combination of year, month and day exists in the 26 | Gregorian calendar. 27 | *) 28 | let validate_date path x = 29 | let y = x.year in 30 | let m = x.month in 31 | let d = x.day in 32 | let success = 33 | m >= 1 && m <= 12 && d >= 1 && 34 | (let dmax = 35 | match m with 36 | 2 -> 37 | if y mod 4 = 0 && not (y mod 100 = 0) || y mod 400 = 0 then 29 38 | else 28 39 | | 1 | 3 | 5 | 7 | 8 | 10 | 12 -> 31 40 | | _ -> 30 41 | in 42 | d <= dmax) 43 | in 44 | if success then None 45 | else Some (Ag_util.Validation.error path) 46 | 47 | (* Compare dates chronologically *) 48 | let compare_date a b = 49 | let c = compare a.year b.year in 50 | if c <> 0 then c 51 | else 52 | let c = compare a.month b.month in 53 | if c <> 0 then c 54 | else compare a.day b.day 55 | 56 | (* Check that the end_date, when defined, is not earlier than the start_date *) 57 | let validate_job path x = 58 | match x.end_date with 59 | None -> None 60 | | Some end_date -> 61 | if compare_date x.start_date end_date <= 0 then 62 | None 63 | else 64 | Some (Ag_util.Validation.error path) 65 | -------------------------------------------------------------------------------- /misc-examples/README.md: -------------------------------------------------------------------------------- 1 | Atdgen examples 2 | =============== 3 | 4 | Examples accumulate here, typically based on questions asked by 5 | users, pending their integration into a better organized document. 6 | 7 | Serialization of type defined in an external library 8 | ---------------------------------------------------- 9 | 10 | ```ocaml 11 | (* 12 | atdgen -t ext.atd 13 | atdgen -j -j-std ext.atd 14 | ocamlfind opt -c -package atdgen ext_t.mli ext_t.ml ext_j.mli ext_j.ml 15 | *) 16 | type status_t = 17 | [ WEXITED of int 18 | | WSIGNALED of int 19 | | WSTOPPED of int ] 20 | ``` 21 | 22 | This produces JSON serialization code (`_j` files) and the following 23 | type re-definition: 24 | 25 | ```ocaml 26 | type status_t = Unix.process_status = 27 | WEXITED of int 28 | | WSIGNALED of int 29 | | WSTOPPED of int 30 | ``` 31 | 32 | Serializing abstract types that come with their own `to_string` and `of_string` 33 | ------------------------------------------------------------------------------- 34 | 35 | ```ocaml 36 | (* 37 | atdgen -t ex.atd 38 | atdgen -j -j-std ex.atd 39 | ocamlfind opt -c -package atdgen ex_t.mli ex_t.ml ex_j.mli ex_j.ml 40 | *) 41 | type calendar = 42 | string wrap 46 | 47 | type has_calendar_t = { 48 | c : calendar; 49 | } 50 | ``` 51 | 52 | produces the following OCaml type definitions: 53 | 54 | ```ocaml 55 | type calendar = Calendar.t 56 | type has_calendar_t = { c: calendar } 57 | ``` 58 | 59 | When converting to JSON, a value of type `calendar` is converted 60 | (unwrapped) into an OCaml string using the supplied function 61 | `Calendar.to_string`. Conversely, when reading from JSON, an OCaml 62 | string is parsed (wrapped) into a `calendar` using the supplied function 63 | `Calendar.of_string`. 64 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: all demo pdf txt html install clean 2 | all: demo pdf txt html 3 | 4 | demo: 5 | cd hello && ./demo.sh 6 | cd pretty-json && ./demo.sh 7 | cd inspect-biniou && ./demo.sh 8 | cd validate && ./demo.sh 9 | cd modularity && ./demo.sh 10 | 11 | pdf: atdgen-tutorial.pdf 12 | txt: atdgen-tutorial.txt 13 | html: atdgen-tutorial.html 14 | 15 | TEXFILES = atdgen-tutorial.tex atdgen-tutorial-body.tex 16 | TUTSRC = $(TEXFILES) \ 17 | config-file/demo.sh config-file/config.atd config-file/config.ml 18 | 19 | atdgen-tutorial.tex: atdgen-tutorial.mlx 20 | OCAMLPATH=../..:$$OCAMLPATH \ 21 | camlmix atdgen-tutorial.mlx -o atdgen-tutorial.tex 22 | 23 | atdgen-tutorial-body.tex: macros.ml atdgen-tutorial-body.mlx 24 | OCAMLPATH=../..:$$OCAMLPATH \ 25 | camlmix atdgen-tutorial-body.mlx -o atdgen-tutorial-body.tex 26 | 27 | atdgen-tutorial.txt: $(TUTSRC) 28 | rm -f *.aux 29 | hevea -fix -text atdgen-tutorial 30 | mv atdgen-tutorial.txt atdgen-tutorial.txt.orig 31 | iconv -f ISO_8859-1 -t UTF-8 < atdgen-tutorial.txt.orig \ 32 | > atdgen-tutorial.txt 33 | 34 | atdgen-tutorial.html: $(TUTSRC) \ 35 | hevea-insert1.html hevea-insert2.html hevea-insert3.html 36 | rm -f *.aux 37 | hevea -fix atdgen-tutorial 38 | sed -i '/<\/STYLE>/ r hevea-insert1.html' atdgen-tutorial.html 39 | sed -i '// r hevea-insert2.html' atdgen-tutorial.html 40 | sed -i 's/<\/BLOCKQUOTE><\/BODY>/<\/BLOCKQUOTE>\n<\/BODY>/' \ 41 | atdgen-tutorial.html 42 | sed -i -e 's:^

.*::' atdgen-tutorial.html 43 | sed -i -e 's:^.*::' atdgen-tutorial.html 44 | sed -i '// r hevea-insert3.html' atdgen-tutorial.html 45 | 46 | atdgen-tutorial.pdf: $(TUTSRC) 47 | pdflatex atdgen-tutorial 48 | pdflatex atdgen-tutorial 49 | pdflatex atdgen-tutorial 50 | 51 | install: 52 | cp atdgen-tutorial.html atdgen-tutorial.txt atdgen-tutorial.pdf \ 53 | ../mylifelabs.github.com/ 54 | cd ../mylifelabs.github.com/; \ 55 | git add atdgen-tutorial.html atdgen-tutorial.txt atdgen-tutorial.pdf; \ 56 | git commit -m "Update"; git push 57 | 58 | clean: 59 | rm -f *~ 60 | rm -f *.aux *.toc *.log *.out *.haux *.htoc *.fls \ 61 | atdgen-tutorial-body.tex atdgen-tutorial.tex \ 62 | atdgen-tutorial.pdf atdgen-tutorial.txt \ 63 | atdgen-tutorial.html \ 64 | *.mlx.ml 65 | rm -f */*_[tbjv].* */*_[tbjv].* */*~ */*.cm[iox] */*.o 66 | rm -f hello/hello pretty-json/prettify \ 67 | inspect-biniou/tree inspect-biniou/tree.dat \ 68 | validate/test_resume modularity/test_modularity 69 | -------------------------------------------------------------------------------- /config-file/config.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | 3 | let param_template = 4 | (* Sample item used to populate the template config file *) 5 | { 6 | Config_v.name = "foo"; 7 | key = "0123456789abcdef" 8 | } 9 | 10 | let config_template = 11 | (* 12 | Records can be conveniently created using functions generated by 13 | "atdgen -v". 14 | Here we use Config_v.create_config to create a record of type 15 | Config_t.config. The big advantage over creating the record 16 | directly using the record notation {...} is that we don't have to 17 | specify default values (such as timeout in this example). 18 | *) 19 | Config_v.create_config ~title:"" ~credentials: [param_template] () 20 | 21 | let make_json_template () = 22 | (* Thanks to the -j-defaults flag passed to atdgen, even default 23 | fields will be printed out *) 24 | let compact_json = Config_j.string_of_config config_template in 25 | Yojson.Safe.prettify compact_json 26 | 27 | let print_template () = 28 | print_endline (make_json_template ()) 29 | 30 | let print_format () = 31 | print_string Config_atd.contents 32 | 33 | let validate fname = 34 | let x = 35 | try 36 | (* Read config data structure from JSON file *) 37 | let x = Ag_util.Json.from_file Config_j.read_config fname in 38 | (* Call the validators specified by *) 39 | if not (Config_v.validate_config x) then 40 | failwith "Some fields are invalid" 41 | else 42 | x 43 | with e -> 44 | (* Print decent error message and exit *) 45 | let msg = 46 | match e with 47 | Failure s 48 | | Yojson.Json_error s -> s 49 | | e -> Printexc.to_string e 50 | in 51 | eprintf "Error: %s\n%!" msg; 52 | exit 1 53 | in 54 | (* Convert config to compact JSON and pretty-print it. 55 | ~std:true means that the output will not use extended syntax for 56 | variants and tuples but only standard JSON. *) 57 | let json = Yojson.Safe.prettify ~std:true (Config_j.string_of_config x) in 58 | print_endline json 59 | 60 | type action = Template | Format | Validate of string 61 | 62 | let main () = 63 | let action = ref Template in 64 | let options = [ 65 | "-template", Arg.Unit (fun () -> action := Template), 66 | " 67 | prints a sample configuration file"; 68 | 69 | "-format", Arg.Unit (fun () -> action := Format), 70 | " 71 | prints the format specification of the config files (atd format)"; 72 | 73 | "-validate", Arg.String (fun s -> action := Validate s), 74 | " 75 | reads a config file, validates it, adds default values 76 | and prints the config nicely to stdout"; 77 | ] 78 | in 79 | let usage_msg = sprintf "\ 80 | Usage: %s [-template|-format|-validate ...] 81 | Demonstration of how to manage JSON configuration files with atdgen. 82 | " 83 | Sys.argv.(0) 84 | in 85 | let anon_fun s = eprintf "Invalid command parameter %S\n%!" s; exit 1 in 86 | Arg.parse options anon_fun usage_msg; 87 | 88 | match !action with 89 | Template -> print_template () 90 | | Format -> print_format () 91 | | Validate s -> validate s 92 | 93 | let () = main () 94 | -------------------------------------------------------------------------------- /macros.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | 3 | let latex_of_string s = 4 | let tokens = Caml2html.Input.string s in 5 | let buf = Buffer.create 1000 in 6 | Caml2html.Output_latex.ocaml buf tokens; 7 | Buffer.contents buf 8 | 9 | let print_ocaml s = 10 | print "\\begin{alltt}"; 11 | print (latex_of_string s); 12 | print "\\end{alltt}" 13 | 14 | (* Validate ATD syntax before printing *) 15 | let print_atd s = 16 | try 17 | ignore (Atd_util.load_string 18 | ~expand:true ~keep_poly:true 19 | ~inherit_fields:true ~inherit_variants:true s); 20 | print_ocaml s 21 | with e -> 22 | let msg = 23 | match e with 24 | Failure s 25 | | Atd_ast.Atd_error s -> s 26 | | _ -> Printexc.to_string e 27 | in 28 | Printf.eprintf "\ 29 | *** Invalid ATD *** 30 | %s 31 | *** Error *** 32 | %s 33 | 34 | %!" 35 | s msg; 36 | raise e 37 | 38 | 39 | 40 | let read_command_output f s = 41 | let ic = Unix.open_process_in s in 42 | (try 43 | while true do 44 | f (input_char ic) 45 | done 46 | with End_of_file -> ()); 47 | match Unix.close_process_in ic with 48 | Unix.WEXITED 0 -> () 49 | | _ -> invalid_arg ("read_command_output: " ^ s) 50 | 51 | 52 | let file_contents fn = 53 | let buf = Buffer.create 1000 in 54 | let ic = open_in fn in 55 | (try 56 | while true do 57 | bprintf buf "%s\n" (input_line ic) 58 | done 59 | with End_of_file -> () 60 | ); 61 | close_in ic; 62 | Buffer.contents buf 63 | 64 | 65 | let shell s = 66 | let buf = Buffer.create 100 in 67 | read_command_output (Buffer.add_char buf) s; 68 | print "\\begin{verbatim}"; 69 | print (Buffer.contents buf); (* no escaping! *) 70 | print "\\end{verbatim}" 71 | 72 | 73 | let check_atdgen ?prefix output_type s = 74 | let fn = 75 | match prefix with 76 | None -> Filename.temp_file "atdgen_" ".atd" 77 | | Some s -> s ^ ".atd" 78 | in 79 | let prefix = Filename.chop_extension fn in 80 | let mli = prefix ^ ".mli" in 81 | let ml = prefix ^ ".ml" in 82 | let oc = open_out fn in 83 | let finally () = 84 | close_out_noerr oc; 85 | Sys.remove fn; 86 | (try Sys.remove mli with _ -> ()); 87 | (try Sys.remove ml with _ -> ()); 88 | in 89 | try 90 | output_string oc s; 91 | close_out oc; 92 | let cmd = 93 | sprintf "../atdgen %s %s" 94 | (match output_type with 95 | `Biniou -> "-biniou" 96 | | `Json -> "-json") 97 | fn 98 | in 99 | match Sys.command cmd with 100 | 0 -> 101 | let mli_data = file_contents mli in 102 | finally (); 103 | mli_data 104 | | n -> 105 | eprintf "\ 106 | -- File %s -- 107 | %s 108 | ---- 109 | Command failed: %s 110 | " 111 | fn s cmd; 112 | finally (); 113 | exit 1 114 | 115 | with e -> 116 | finally (); 117 | raise e 118 | 119 | 120 | let print_atdgen ot s = 121 | ignore (check_atdgen ot s); 122 | print_atd s 123 | 124 | 125 | 126 | let ocaml () = 127 | Camlmix.print_with print_ocaml 128 | 129 | let atd () = 130 | Camlmix.print_with print_atd 131 | 132 | let atdgen_biniou () = 133 | Camlmix.print_with (print_atdgen `Biniou) 134 | 135 | let atdgen_json () = 136 | Camlmix.print_with (print_atdgen `Json) 137 | 138 | let atdgen = atdgen_biniou 139 | 140 | 141 | let print_atdgen_mli ?prefix ot msg s = 142 | let mli = check_atdgen ?prefix ot s in 143 | print_atd s; 144 | print msg; 145 | print_ocaml mli 146 | 147 | 148 | let atdgen_biniou_mli ?prefix msg = 149 | Camlmix.print_with (print_atdgen_mli ?prefix `Biniou msg) 150 | 151 | let atdgen_json_mli ?prefix msg = 152 | Camlmix.print_with (print_atdgen_mli ?prefix `Json msg) 153 | -------------------------------------------------------------------------------- /atdgen-tutorial.mlx: -------------------------------------------------------------------------------- 1 | % -*- latex -*- 2 | \documentclass[letterpaper,10pt]{article} 3 | 4 | \usepackage{ae} 5 | \usepackage{hyperref} 6 | \usepackage{hevea} 7 | 8 | \usepackage{verbatim} 9 | \usepackage{alltt} 10 | 11 | \usepackage[latin1]{inputenc} 12 | \usepackage[T1]{fontenc} 13 | \usepackage{url} 14 | 15 | \usepackage{booktabs} 16 | 17 | \title{Atdgen tutorial} 18 | \author{Martin Jambon\\ 19 | $\copyright$ 2011 MyLife} 20 | %\date{October 19, 2072} 21 | \pagestyle{headings} 22 | 23 | % We suppress indentation at the beginning of each paragraph because paragraphs 24 | % are short and indentation is used heavily for bullet points and code examples 25 | \setlength{\parindent}{0mm} 26 | \setlength{\parskip}{2mm} 27 | 28 | % Thickness of top and bottom lines of tables (\toprule, \bottomrule) 29 | \setlength{\heavyrulewidth}{1.5pt} 30 | % Note: \toprule, \midrule and \bottomrule are really nice-looking but are not 31 | % understood by hevea. 32 | 33 | \usepackage{alltt} 34 | \usepackage{color} 35 | \newcommand\Clinenum[1]{#1} 36 | \definecolor{CconstructorColor}{rgb}{0.00,0.20,0.80} 37 | \newcommand\Cconstructor[1]{\textcolor{CconstructorColor}{#1}} 38 | \definecolor{CcommentColor}{rgb}{0.60,0.00,0.00} 39 | \newcommand\Ccomment[1]{\textcolor{CcommentColor}{#1}} 40 | \definecolor{CstringColor}{rgb}{0.67,0.27,0.27} 41 | \newcommand\Cstring[1]{\textcolor{CstringColor}{#1}} 42 | \newcommand\Cquotation[1]{#1} 43 | \definecolor{CalphakeywordColor}{rgb}{0.50,0.50,0.50} 44 | \newcommand\Calphakeyword[1]{\textcolor{CalphakeywordColor}{#1}} 45 | \newcommand\Cnonalphakeyword[1]{#1} 46 | \definecolor{CandColor}{rgb}{0.00,0.50,0.00} 47 | \newcommand\Cand[1]{\textcolor{CandColor}{#1}} 48 | \definecolor{CasColor}{rgb}{0.00,0.50,0.00} 49 | \newcommand\Cas[1]{\textcolor{CasColor}{#1}} 50 | \definecolor{CclassColor}{rgb}{0.00,0.50,0.00} 51 | \newcommand\Cclass[1]{\textcolor{CclassColor}{#1}} 52 | \definecolor{CconstraintColor}{rgb}{0.00,0.50,0.00} 53 | \newcommand\Cconstraint[1]{\textcolor{CconstraintColor}{#1}} 54 | \definecolor{CexceptionColor}{rgb}{0.00,0.50,0.00} 55 | \newcommand\Cexception[1]{\textcolor{CexceptionColor}{#1}} 56 | \definecolor{CexternalColor}{rgb}{0.00,0.50,0.00} 57 | \newcommand\Cexternal[1]{\textcolor{CexternalColor}{#1}} 58 | \definecolor{CfunColor}{rgb}{0.00,0.50,0.00} 59 | \newcommand\Cfun[1]{\textcolor{CfunColor}{#1}} 60 | \definecolor{CfunctionColor}{rgb}{0.00,0.50,0.00} 61 | \newcommand\Cfunction[1]{\textcolor{CfunctionColor}{#1}} 62 | \definecolor{CfunctorColor}{rgb}{0.00,0.50,0.00} 63 | \newcommand\Cfunctor[1]{\textcolor{CfunctorColor}{#1}} 64 | \definecolor{CinColor}{rgb}{0.00,0.50,0.00} 65 | \newcommand\Cin[1]{\textcolor{CinColor}{#1}} 66 | \definecolor{CinheritColor}{rgb}{0.00,0.50,0.00} 67 | \newcommand\Cinherit[1]{\textcolor{CinheritColor}{#1}} 68 | \definecolor{CinitializerColor}{rgb}{0.00,0.50,0.00} 69 | \newcommand\Cinitializer[1]{\textcolor{CinitializerColor}{#1}} 70 | \definecolor{CletColor}{rgb}{0.00,0.50,0.00} 71 | \newcommand\Clet[1]{\textcolor{CletColor}{#1}} 72 | \definecolor{CmethodColor}{rgb}{0.00,0.50,0.00} 73 | \newcommand\Cmethod[1]{\textcolor{CmethodColor}{#1}} 74 | %\definecolor{CmoduleColor}{rgb}{0.00,0.50,0.00} 75 | %\newcommand\Cmodule[1]{\textcolor{CmoduleColor}{#1}} 76 | \definecolor{CmutableColor}{rgb}{0.00,0.50,0.00} 77 | \newcommand\Cmutable[1]{\textcolor{CmutableColor}{#1}} 78 | \definecolor{CofColor}{rgb}{0.00,0.50,0.00} 79 | \newcommand\Cof[1]{\textcolor{CofColor}{#1}} 80 | \definecolor{CprivateColor}{rgb}{0.00,0.50,0.00} 81 | \newcommand\Cprivate[1]{\textcolor{CprivateColor}{#1}} 82 | \definecolor{CrecColor}{rgb}{0.00,0.50,0.00} 83 | \newcommand\Crec[1]{\textcolor{CrecColor}{#1}} 84 | \definecolor{CtypeColor}{rgb}{0.00,0.50,0.00} 85 | \newcommand\Ctype[1]{\textcolor{CtypeColor}{#1}} 86 | \definecolor{CvalColor}{rgb}{0.00,0.50,0.00} 87 | \newcommand\Cval[1]{\textcolor{CvalColor}{#1}} 88 | \definecolor{CvirtualColor}{rgb}{0.00,0.50,0.00} 89 | \newcommand\Cvirtual[1]{\textcolor{CvirtualColor}{#1}} 90 | \definecolor{CdoColor}{rgb}{0.47,0.67,0.67} 91 | \newcommand\Cdo[1]{\textcolor{CdoColor}{#1}} 92 | \definecolor{CdoneColor}{rgb}{0.47,0.67,0.67} 93 | \newcommand\Cdone[1]{\textcolor{CdoneColor}{#1}} 94 | \definecolor{CdowntoColor}{rgb}{0.47,0.67,0.67} 95 | \newcommand\Cdownto[1]{\textcolor{CdowntoColor}{#1}} 96 | \definecolor{CelseColor}{rgb}{0.47,0.67,0.67} 97 | \newcommand\Celse[1]{\textcolor{CelseColor}{#1}} 98 | \definecolor{CforColor}{rgb}{0.47,0.67,0.67} 99 | \newcommand\Cfor[1]{\textcolor{CforColor}{#1}} 100 | \definecolor{CifColor}{rgb}{0.47,0.67,0.67} 101 | \newcommand\Cif[1]{\textcolor{CifColor}{#1}} 102 | \definecolor{ClazyColor}{rgb}{0.47,0.67,0.67} 103 | \newcommand\Clazy[1]{\textcolor{ClazyColor}{#1}} 104 | \definecolor{CmatchColor}{rgb}{0.47,0.67,0.67} 105 | \newcommand\Cmatch[1]{\textcolor{CmatchColor}{#1}} 106 | \definecolor{CnewColor}{rgb}{0.47,0.67,0.67} 107 | \newcommand\Cnew[1]{\textcolor{CnewColor}{#1}} 108 | \definecolor{CorColor}{rgb}{0.47,0.67,0.67} 109 | \newcommand\Cor[1]{\textcolor{CorColor}{#1}} 110 | \definecolor{CthenColor}{rgb}{0.47,0.67,0.67} 111 | \newcommand\Cthen[1]{\textcolor{CthenColor}{#1}} 112 | \definecolor{CtoColor}{rgb}{0.47,0.67,0.67} 113 | \newcommand\Cto[1]{\textcolor{CtoColor}{#1}} 114 | \definecolor{CtryColor}{rgb}{0.47,0.67,0.67} 115 | \newcommand\Ctry[1]{\textcolor{CtryColor}{#1}} 116 | \definecolor{CwhenColor}{rgb}{0.47,0.67,0.67} 117 | \newcommand\Cwhen[1]{\textcolor{CwhenColor}{#1}} 118 | \definecolor{CwhileColor}{rgb}{0.47,0.67,0.67} 119 | \newcommand\Cwhile[1]{\textcolor{CwhileColor}{#1}} 120 | \definecolor{CwithColor}{rgb}{0.47,0.67,0.67} 121 | \newcommand\Cwith[1]{\textcolor{CwithColor}{#1}} 122 | \definecolor{CassertColor}{rgb}{0.80,0.60,0.00} 123 | \newcommand\Cassert[1]{\textcolor{CassertColor}{#1}} 124 | \definecolor{CincludeColor}{rgb}{0.80,0.60,0.00} 125 | \newcommand\Cinclude[1]{\textcolor{CincludeColor}{#1}} 126 | \definecolor{CopenColor}{rgb}{0.80,0.60,0.00} 127 | \newcommand\Copen[1]{\textcolor{CopenColor}{#1}} 128 | \definecolor{CbeginColor}{rgb}{0.60,0.00,0.60} 129 | \newcommand\Cbegin[1]{\textcolor{CbeginColor}{#1}} 130 | \definecolor{CendColor}{rgb}{0.60,0.00,0.60} 131 | \newcommand\Cend[1]{\textcolor{CendColor}{#1}} 132 | \definecolor{CobjectColor}{rgb}{0.60,0.00,0.60} 133 | \newcommand\Cobject[1]{\textcolor{CobjectColor}{#1}} 134 | \definecolor{CsigColor}{rgb}{0.60,0.00,0.60} 135 | \newcommand\Csig[1]{\textcolor{CsigColor}{#1}} 136 | \definecolor{CstructColor}{rgb}{0.60,0.00,0.60} 137 | \newcommand\Cstruct[1]{\textcolor{CstructColor}{#1}} 138 | \definecolor{CraiseColor}{rgb}{1.00,0.00,0.00} 139 | \newcommand\Craise[1]{\textcolor{CraiseColor}{#1}} 140 | \definecolor{CasrColor}{rgb}{0.50,0.50,0.50} 141 | \newcommand\Casr[1]{\textcolor{CasrColor}{#1}} 142 | \definecolor{ClandColor}{rgb}{0.50,0.50,0.50} 143 | \newcommand\Cland[1]{\textcolor{ClandColor}{#1}} 144 | \definecolor{ClorColor}{rgb}{0.50,0.50,0.50} 145 | \newcommand\Clor[1]{\textcolor{ClorColor}{#1}} 146 | \definecolor{ClslColor}{rgb}{0.50,0.50,0.50} 147 | \newcommand\Clsl[1]{\textcolor{ClslColor}{#1}} 148 | \definecolor{ClsrColor}{rgb}{0.50,0.50,0.50} 149 | \newcommand\Clsr[1]{\textcolor{ClsrColor}{#1}} 150 | \definecolor{ClxorColor}{rgb}{0.50,0.50,0.50} 151 | \newcommand\Clxor[1]{\textcolor{ClxorColor}{#1}} 152 | \definecolor{CmodColor}{rgb}{0.50,0.50,0.50} 153 | \newcommand\Cmod[1]{\textcolor{CmodColor}{#1}} 154 | \newcommand\Cfalse[1]{#1} 155 | \newcommand\Ctrue[1]{#1} 156 | \definecolor{CbarColor}{rgb}{0.47,0.67,0.67} 157 | \newcommand\Cbar[1]{\textcolor{CbarColor}{#1}} 158 | 159 | % Exception: 160 | \newcommand\Cmodule[1]{#1} 161 | 162 | \newcommand\bs{$\mathtt\backslash$} 163 | 164 | \begin{document} 165 | \maketitle 166 | \tableofcontents 167 | \include{atdgen-tutorial-body} 168 | \end{document} 169 | -------------------------------------------------------------------------------- /atdgen-tutorial-body.mlx: -------------------------------------------------------------------------------- 1 | % -*- latex -*- 2 | ## 3 | #use "topfind";; 4 | #require "caml2html";; 5 | #require "atd";; 6 | #require "unix";; 7 | #use "macros.ml";; 8 | ## 9 | 10 | \section{What is Atdgen?} 11 | 12 | Atdgen is a tool that derives OCaml boilerplate code from type definitions. 13 | Currently it provides support for: 14 | 15 | \begin{itemize} 16 | \item \href{http://json.org/}{JSON} serialization and deserialization. 17 | \item \href{http://martin.jambon.free.fr/biniou-format.txt}{Biniou} 18 | serialization and deserialization. 19 | Biniou is a binary format extensible like JSON but more compact 20 | and faster to process. 21 | \item Convenience functions for creating and validating OCaml data. 22 | \end{itemize} 23 | 24 | \section{What are the advantages of Atdgen?} 25 | 26 | Atdgen has a number of advantages over its predecessor json-static 27 | which was based on Camlp4: 28 | \begin{itemize} 29 | \item produces explicit interfaces which describe what is available to 30 | the user (\texttt{.mli} files). 31 | \item produces readable OCaml code that can be easily reviewed 32 | (\texttt{.ml} files). 33 | \item produces fast code, 3x faster than json-static. 34 | \item runs fast, keeping build times low. 35 | \item same ATD definitions can be used to generate code other than 36 | OCaml. See for instance 37 | \href{https://github.com/MyLifeLabs/atdj}{Atdj} 38 | which generates Java classes for JSON IO. 39 | Auto-generating GUI widgets from type definitions is another 40 | popular use of annotated type definitions. The implementation of 41 | such code generators is facilitated by the 42 | \href{http://oss.wink.com/atd/}{\texttt{atd}} library. 43 | \end{itemize} 44 | 45 | 46 | \section{Prerequisites} 47 | 48 | This tutorial assumes that you are using Atdgen version 1.2.0 or above. 49 | The following command tells you which version you are using: 50 | 51 | \begin{verbatim} 52 | $ atdgen -version 53 | 1.2.0 54 | \end{verbatim} 55 | 56 | A quick way of installing Atdgen and all its dependencies is via Godi. 57 | 58 | Alternatively, read and follow the instructions in the 59 | \texttt{INSTALL} file of the source package of Atdgen. 60 | 61 | 62 | \section{Getting started} 63 | 64 | From now on we assume that Atdgen 1.2.0 or above is installed properly. 65 | 66 | \begin{verbatim} 67 | $ atdgen -version 68 | 1.2.0 69 | \end{verbatim} 70 | 71 | Type definitions are placed in a \texttt{.atd} file (\texttt{hello.atd}): 72 | 73 | ## ocaml () ## 74 | type date = { 75 | year : int; 76 | month : int; 77 | day : int; 78 | } 79 | ## () ## 80 | 81 | Our handwritten OCaml program is \texttt{hello.ml}: 82 | 83 | ## ocaml () ## 84 | open Hello_t 85 | let () = 86 | let date = { year = 1970; month = 1; day = 1 } in 87 | print_endline (Hello_j.string_of_date date) 88 | ## () ## 89 | 90 | We produce OCaml code from the type definitions using \texttt{atdgen}: 91 | 92 | \begin{verbatim} 93 | $ atdgen -t hello.atd # produces OCaml type definitions 94 | $ atdgen -j hello.atd # produces OCaml code dealing with JSON 95 | \end{verbatim} 96 | 97 | We now have \texttt{\_t} and \texttt{\_j} files produced by \texttt{atdgen -t} and \texttt{atdgen -j} 98 | respectively: 99 | 100 | \begin{verbatim} 101 | $ ls 102 | hello.atd hello.ml hello_j.ml hello_j.mli hello_t.ml hello_t.mli 103 | \end{verbatim} 104 | 105 | We compile all \texttt{.mli} and \texttt{.ml} files: 106 | 107 | \begin{verbatim} 108 | $ ocamlfind ocamlc -c hello_t.mli -package atdgen 109 | $ ocamlfind ocamlc -c hello_j.mli -package atdgen 110 | $ ocamlfind ocamlopt -c hello_t.ml -package atdgen 111 | $ ocamlfind ocamlopt -c hello_j.ml -package atdgen 112 | $ ocamlfind ocamlopt -c hello.ml -package atdgen 113 | $ ocamlfind ocamlopt -o hello hello_t.cmx hello_j.cmx hello.cmx \ 114 | -package atdgen -linkpkg 115 | \end{verbatim} 116 | 117 | And finally we run our \texttt{hello} program: 118 | 119 | \begin{verbatim} 120 | $ ./hello 121 | {"year":1970,"month":1,"day":1} 122 | \end{verbatim} 123 | 124 | 125 | Source code for this section: 126 | \url{https://github.com/MyLifeLabs/atdgen-tutorial/tree/master/hello} 127 | 128 | 129 | \section{Inspecting and pretty-printing JSON} 130 | 131 | Input JSON data: 132 | 133 | \begin{verbatim} 134 | $ cat single.json 135 | [1234,"abcde",{"start_date":{"year":1970,"month":1,"day":1}, 136 | "end_date":{"year":1980,"month":1,"day":1}}] 137 | \end{verbatim} 138 | 139 | Pretty-printed JSON can be produced with the \texttt{ydump} command: 140 | 141 | \begin{verbatim} 142 | $ ydump single.json 143 | [ 144 | 1234, 145 | "abcde", 146 | { 147 | "start_date": { "year": 1970, "month": 1, "day": 1 }, 148 | "end_date": { "year": 1980, "month": 1, "day": 1 } 149 | } 150 | ] 151 | \end{verbatim} 152 | 153 | Multiple JSON objects separated by whitespace, typically one JSON object 154 | per line, can also be pretty-printed with \texttt{ydump}. Input: 155 | 156 | \begin{verbatim} 157 | $ cat stream.json 158 | [1234,"abcde",{"start_date":{"year":1970,"month":1,"day":1}, 159 | "end_date":{"year":1980,"month":1,"day":1}}] 160 | [1,"a",{}] 161 | \end{verbatim} 162 | 163 | In this case the \texttt{-s} option is required: 164 | 165 | \begin{verbatim} 166 | $ ydump -s stream.json 167 | [ 168 | 1234, 169 | "abcde", 170 | { 171 | "start_date": { "year": 1970, "month": 1, "day": 1 }, 172 | "end_date": { "year": 1980, "month": 1, "day": 1 } 173 | } 174 | ] 175 | [ 1, "a", {} ] 176 | \end{verbatim} 177 | 178 | From an OCaml program, pretty-printing can be done with 179 | \texttt{Yojson.Safe.prettify} 180 | which has the following signature: 181 | 182 | ## ocaml () ## 183 | val prettify : string -> string 184 | ## () ## 185 | 186 | We wrote a tiny program that simply calls the \texttt{prettify} function on 187 | some predefined JSON data (file \texttt{prettify.ml}): 188 | 189 | ## ocaml () ## 190 | let json = 191 | "[1234,\"abcde\",{\"start_date\":{\"year\":1970,\"month\":1,\"day\":1}, 192 | \"end_date\":{\"year\":1980,\"month\":1,\"day\":1}}]" 193 | 194 | let () = print_endline (Yojson.Safe.prettify json) 195 | ## () ## 196 | 197 | We now compile and run prettify.ml: 198 | 199 | \begin{verbatim} 200 | $ ocamlfind ocamlopt -o prettify prettify.ml -package atdgen -linkpkg 201 | $ ./prettify 202 | [ 203 | 1234, 204 | "abcde", 205 | { 206 | "start_date": { "year": 1970, "month": 1, "day": 1 }, 207 | "end_date": { "year": 1980, "month": 1, "day": 1 } 208 | } 209 | ] 210 | \end{verbatim} 211 | 212 | Source code for this section: 213 | \url{https://github.com/MyLifeLabs/atdgen-tutorial/tree/master/pretty-json} 214 | 215 | 216 | 217 | \section{Inspecting biniou data} 218 | 219 | Biniou is a binary format that can be displayed as text using a generic 220 | command called \texttt{bdump}. The only practical difficulty is to recover 221 | the original field names and variant names which are stored as 31-bit hashes. 222 | Unhashing them is done by consulting a dictionary (list of words) 223 | maintained by the user. 224 | 225 | Let's first produce a sample data file \texttt{tree.dat} containing the 226 | biniou representation of a binary tree. In the same program 227 | we will also demonstrate how to render biniou data into text from an 228 | OCaml program. 229 | 230 | Here is the ATD file defining our tree type (file \texttt{tree.atd}): 231 | 232 | ## atd () ## 233 | type tree = 234 | [ Empty 235 | | Node of (tree * int * tree) ] 236 | ## () ## 237 | 238 | This is our OCaml program (file \texttt{tree.ml}): 239 | 240 | ## ocaml () ## 241 | open Printf 242 | 243 | (* sample value *) 244 | let tree : Tree_t.tree = 245 | `Node ( 246 | `Node (`Empty, 1, `Empty), 247 | 2, 248 | `Node ( 249 | `Node (`Empty, 3, `Empty), 250 | 4, 251 | `Node (`Empty, 5, `Empty) 252 | ) 253 | ) 254 | 255 | let () = 256 | (* write sample value to file *) 257 | let fname = "tree.dat" in 258 | Ag_util.Biniou.to_file Tree_b.write_tree fname tree; 259 | 260 | (* write sample value to string *) 261 | let s = Tree_b.string_of_tree tree in 262 | printf "raw value (saved as %s):\n%S\n" fname s; 263 | printf "length: %i\n" (String.length s); 264 | 265 | printf "pretty-printed value (without dictionary):\n"; 266 | print_endline (Bi_io.view s); 267 | 268 | printf "pretty-printed value (with dictionary):\n"; 269 | let unhash = Bi_io.make_unhash ["Empty"; "Node"; "foo"; "bar" ] in 270 | print_endline (Bi_io.view ~unhash s) 271 | ## () ## 272 | 273 | Compilation: 274 | 275 | \begin{verbatim} 276 | $ atdgen -t tree.atd 277 | $ atdgen -b tree.atd 278 | $ ocamlfind ocamlopt -o tree \ 279 | tree_t.mli tree_t.ml tree_b.mli tree_b.ml tree.ml \ 280 | -package atdgen -linkpkg 281 | \end{verbatim} 282 | 283 | Running the program: 284 | 285 | \begin{verbatim} 286 | $ ./tree 287 | raw value (saved as tree.dat): 288 | "\023\179\2276\"\020\003\023\179\2276\"\020\003\023\003\007\170m\017\002\023\003\007\170m\017\004\023\179\2276\"\020\003\023\179\2276\"\020\003\023\003\007\170m\017\006\023\003\007\170m\017\b\023\179\2276\"\020\003\023\003\007\170m\017\n\023\003\007\170m" 289 | length: 75 290 | pretty-printed value (without dictionary): 291 | <#33e33622: 292 | (<#33e33622: (<#0307aa6d>, 1, <#0307aa6d>)>, 293 | 2, 294 | <#33e33622: 295 | (<#33e33622: (<#0307aa6d>, 3, <#0307aa6d>)>, 296 | 4, 297 | <#33e33622: (<#0307aa6d>, 5, <#0307aa6d>)>)>)> 298 | pretty-printed value (with dictionary): 299 | <"Node": 300 | (<"Node": (<"Empty">, 1, <"Empty">)>, 301 | 2, 302 | <"Node": 303 | (<"Node": (<"Empty">, 3, <"Empty">)>, 304 | 4, 305 | <"Node": (<"Empty">, 5, <"Empty">)>)>)> 306 | \end{verbatim} 307 | 308 | Now let's see how to pretty-print any biniou data from the command line. 309 | Our sample data are now in file \texttt{tree.dat}: 310 | 311 | \begin{verbatim} 312 | $ ls -l tree.dat 313 | -rw-r--r-- 1 martin martin 75 Apr 17 01:46 tree.dat 314 | \end{verbatim} 315 | 316 | We use the command \texttt{bdump} to render our sample biniou data as text: 317 | 318 | \begin{verbatim} 319 | $ bdump tree.dat 320 | <#33e33622: 321 | (<#33e33622: (<#0307aa6d>, 1, <#0307aa6d>)>, 322 | 2, 323 | <#33e33622: 324 | (<#33e33622: (<#0307aa6d>, 3, <#0307aa6d>)>, 325 | 4, 326 | <#33e33622: (<#0307aa6d>, 5, <#0307aa6d>)>)>)> 327 | \end{verbatim} 328 | 329 | We got hashes for the variant names \texttt{Empty} and \texttt{Node}. 330 | Let's add them to the dictionary: 331 | 332 | \begin{verbatim} 333 | $ bdump -w Empty,Node tree.dat 334 | <"Node": 335 | (<"Node": (<"Empty">, 1, <"Empty">)>, 336 | 2, 337 | <"Node": 338 | (<"Node": (<"Empty">, 3, <"Empty">)>, 339 | 4, 340 | <"Node": (<"Empty">, 5, <"Empty">)>)>)> 341 | \end{verbatim} 342 | 343 | \texttt{bdump} remembers the dictionary so we don't have to pass the 344 | \texttt{-w} option anymore (for this user on this machine). 345 | The following now works: 346 | 347 | \begin{verbatim} 348 | $ bdump tree.dat 349 | <"Node": 350 | (<"Node": (<"Empty">, 1, <"Empty">)>, 351 | 2, 352 | <"Node": 353 | (<"Node": (<"Empty">, 3, <"Empty">)>, 354 | 4, 355 | <"Node": (<"Empty">, 5, <"Empty">)>)>)> 356 | \end{verbatim} 357 | 358 | Source code for this section: 359 | \url{https://github.com/MyLifeLabs/atdgen-tutorial/tree/master/inspect-biniou} 360 | 361 | \section{\label{defaults}Optional fields and default values} 362 | 363 | Although OCaml records do not support optional fields, both the JSON 364 | and biniou formats make it possible to omit certain fields on a 365 | per-record basis. 366 | 367 | For example the JSON record \texttt{\{ "x": 0, "y": 0 \}} can be more 368 | compactly written as \texttt{\{\}} if the reader knows the default values for 369 | the missing fields \texttt{x} and \texttt{y}. Here is the corresponding type 370 | definition: 371 | 372 | ## atd () ## 373 | type vector_v1 = { ~x: int; ~y: int } 374 | ## () ## 375 | 376 | \texttt{\~{}x} means that field \texttt{x} supports a default 377 | value. Since we do not 378 | specify the default value ourselves, the built-in default is used, 379 | which is 0. 380 | 381 | If we want the default to be something else than 0, we just have to 382 | specify it as follows: 383 | 384 | ## atd () ## 385 | type vector_v2 = { 386 | ~x : int; (* default x is 1 *) 387 | ~y: int; (* default y is 0 *) 388 | } 389 | ## () ## 390 | 391 | It is also possible to specify optional fields without a default 392 | value. For example, let's add an optional \texttt{z} field: 393 | 394 | ## atd () ## 395 | type vector_v3 = { 396 | ~x: int; 397 | ~y: int; 398 | ?z: int option; 399 | } 400 | ## () ## 401 | 402 | The following two examples are valid JSON representations of data of 403 | type \texttt{vector\_v3}: 404 | 405 | \begin{verbatim} 406 | { "x": 2, "y": 2, "z": 3 } // OCaml: { x = 2; y = 2; z = Some 3 } 407 | \end{verbatim} 408 | 409 | \begin{verbatim} 410 | { "x": 2, "y": 2 } // OCaml: { x = 2; y = 2; z = None } 411 | \end{verbatim} 412 | 413 | For a variety of good reasons JSON's \texttt{null} value may not be used to 414 | indicate that a field is undefined. 415 | Therefore the following JSON data cannot be read as a record of type 416 | \texttt{vector\_v3}: 417 | 418 | \begin{verbatim} 419 | { "x": 2, "y": 2, "z": null } // invalid value for field z 420 | \end{verbatim} 421 | 422 | 423 | Note also the difference between \texttt{?z: int option} and \texttt{\~{}z: int 424 | option}: 425 | 426 | ## atd () ## 427 | type vector_v4 = { 428 | ~x: int; 429 | ~y: int; 430 | ~z: int option; (* no unwrapping of the JSON field value! *) 431 | } 432 | ## () ## 433 | 434 | Here are valid values of type \texttt{vector\_v4}, showing that it is usually 435 | not what is intended: 436 | 437 | \begin{verbatim} 438 | { "x": 2, "y": 2, "z": [ "Some", 3 ] } 439 | \end{verbatim} 440 | 441 | \begin{verbatim} 442 | { "x": 2, "y": 2, "z": "None" } 443 | \end{verbatim} 444 | 445 | \begin{verbatim} 446 | { "x": 2, "y": 2 } 447 | \end{verbatim} 448 | 449 | 450 | \section{Smooth protocol upgrades} 451 | 452 | Problem: you have a production system that uses a specific 453 | JSON or biniou format. It may be data files or a client-server 454 | pair. You now want to add a field to a record type or to add a case to 455 | a variant type. 456 | 457 | Both JSON and biniou allow extra record fields. If the 458 | consumer does not know how to deal with the extra field, the default 459 | behavior is to happily ignore it. 460 | 461 | 462 | \subsection{Adding or removing an optional record field} 463 | 464 | ## atd () ## 465 | type t = { 466 | x: int; 467 | y: int; 468 | } 469 | ## () ## 470 | 471 | Same \texttt{.atd} source file, edited: 472 | 473 | ## atd () ## 474 | type t = { 475 | x: int; 476 | y: int; 477 | ~z: int; (* new field *) 478 | } 479 | ## () ## 480 | 481 | \begin{itemize} 482 | \item Upgrade producers and consumers in any order 483 | \item Converting old data is not required nor useful 484 | \end{itemize} 485 | 486 | \subsection{Adding a required record field} 487 | 488 | ## atd () ## 489 | type t = { 490 | x: int; 491 | y: int; 492 | } 493 | ## () ## 494 | 495 | Same \texttt{.atd} source file, edited: 496 | 497 | ## atd () ## 498 | type t = { 499 | x: int; 500 | y: int; 501 | z: int; (* new field *) 502 | } 503 | ## () ## 504 | 505 | \begin{itemize} 506 | \item Upgrade all producers before the consumers 507 | \item Converting old data requires special-purpose hand-written code 508 | \end{itemize} 509 | 510 | \subsection{Removing a required record field} 511 | 512 | \begin{itemize} 513 | \item Upgrade all consumers before the producers 514 | \item Converting old data is not required but may save some storage space 515 | (just read and re-write each record using the new type) 516 | \end{itemize} 517 | 518 | \subsection{Adding a variant case} 519 | 520 | ## atd () ## 521 | type t = [ A | B ] 522 | ## () ## 523 | 524 | Same \texttt{.atd} source file, edited: 525 | 526 | ## atd () ## 527 | type t = [ A | B | C ] 528 | ## () ## 529 | 530 | \begin{itemize} 531 | \item Upgrade all consumers before the producers 532 | \item Converting old data is not required and would have no effect 533 | \end{itemize} 534 | 535 | \subsection{Removing a variant case} 536 | 537 | \begin{itemize} 538 | \item Upgrade all producers before the consumers 539 | \item Converting old data requires special-purpose hand-written code 540 | \end{itemize} 541 | 542 | \subsection{Avoiding future problems} 543 | 544 | \begin{itemize} 545 | \item In doubt, use records rather than tuples because it makes it 546 | possible to add or remove any field or to reorder them. 547 | \item Do not hesitate to create variant types with only one case or 548 | records with only one field if you think they might be extended 549 | later. 550 | \end{itemize} 551 | 552 | 553 | \section{Data validation} 554 | 555 | Atdgen can be used to produce data validators for all types defined 556 | in an ATD file, 557 | based on user-given validators specified only for certain types. 558 | A simple example is: 559 | 560 | ## atd () ## 561 | type t = string option 562 | ## () ## 563 | 564 | \texttt{atdgen -v} will produce something equivalent to the following 565 | implementation: 566 | 567 | ## ocaml () ## 568 | let validate_t x = 569 | match x with 570 | None -> true 571 | | Some x -> (fun s -> String.length s >= 8) x 572 | ## () ## 573 | 574 | Let's now consider a more realistic example with complex validators defined 575 | in a separate .ml file. We created the following 3 source files: 576 | 577 | \begin{itemize} 578 | \item \texttt{resume.atd}: contains the type definitions with annotations 579 | \item \texttt{resume\_util.ml}: contains our handwritten validators 580 | \item \texttt{resume.ml}: is our main program that creates data and 581 | calls the validators 582 | \end{itemize} 583 | 584 | In terms of OCaml modules we have: 585 | 586 | \begin{itemize} 587 | \item \texttt{Resume\_t}: produced by \texttt{atdgen -t resume.atd}, 588 | provides OCaml type definitions 589 | \item \texttt{Resume\_util}: depends on \texttt{Resume\_t}, provides 590 | validators mentioned in \texttt{resume.atd} 591 | \item \texttt{Resume\_v}: produced by \texttt{atdgen -v resume.atd}, 592 | depends on \texttt{Resume\_util}, provides a validator for each type 593 | \item \texttt{Resume}: depends on \texttt{Resume\_v}, uses the validators 594 | \end{itemize} 595 | 596 | Type definitions are placed in \texttt{resume.atd}: 597 | 598 | ## atd () ## 599 | type text = string 600 | 601 | type date = { 602 | year : int; 603 | month : int; 604 | day : int; 605 | } 606 | 607 | type job = { 608 | company : text; 609 | title : text; 610 | start_date : date; 611 | ?end_date : date option; 612 | } 613 | 614 | type work_experience = job list 615 | ## () ## 616 | 617 | \texttt{resume\_util.ml} contains our handwritten validators: 618 | 619 | ## ocaml () ## 620 | open Resume_t 621 | 622 | let ascii_printable c = 623 | let n = Char.code c in 624 | n >= 32 && n <= 127 625 | 626 | (* 627 | Check that string is not empty and contains only ASCII printable 628 | characters (for the sake of the example; we use UTF-8 these days) 629 | *) 630 | let validate_some_text s = 631 | s <> "" && 632 | try 633 | String.iter (fun c -> if not (ascii_printable c) then raise Exit) s; 634 | true 635 | with Exit -> 636 | false 637 | 638 | (* 639 | Check that the combination of year, month and day exists in the 640 | Gregorian calendar. 641 | *) 642 | let validate_date x = 643 | let y = x.year in 644 | let m = x.month in 645 | let d = x.day in 646 | m >= 1 && m <= 12 && d >= 1 && 647 | (let dmax = 648 | match m with 649 | 2 -> 650 | if y mod 4 = 0 && not (y mod 100 = 0) || y mod 400 = 0 then 29 651 | else 28 652 | | 1 | 3 | 5 | 7 | 8 | 10 | 12 -> 31 653 | | _ -> 30 654 | in 655 | d <= dmax) 656 | 657 | (* Compare dates chronologically *) 658 | let compare_date a b = 659 | let c = compare a.year b.year in 660 | if c <> 0 then c 661 | else 662 | let c = compare a.month b.month in 663 | if c <> 0 then c 664 | else compare a.day b.day 665 | 666 | (* Check that the end_date, when defined, is not earlier than the start_date *) 667 | let validate_job x = 668 | match x.end_date with 669 | None -> true 670 | | Some end_date -> 671 | compare_date x.start_date end_date <= 0 672 | ## () ## 673 | 674 | \texttt{resume.ml} uses the \texttt{validate\_work\_experience} 675 | function provided by the \texttt{Resume\_v} module: 676 | 677 | ## ocaml () ## 678 | let check_experience x = 679 | let is_valid = Resume_v.validate_work_experience x in 680 | Printf.printf "%s:\n%s\n" 681 | (if is_valid then "VALID" else "INVALID") 682 | (Yojson.Safe.prettify (Resume_j.string_of_work_experience x)) 683 | 684 | let () = 685 | (* one valid date *) 686 | let valid = { Resume_t.year = 2000; month = 2; day = 29 } in 687 | (* one invalid date *) 688 | let invalid = { Resume_t.year = 1900; month = 0; day = 0 } in 689 | (* two more valid dates, created with Resume_v.create_date *) 690 | let date1 = { Resume_t.year = 2005; month = 8; day = 1 } in 691 | let date2 = { Resume_t.year = 2006; month = 3; day = 22 } in 692 | 693 | let job = { 694 | Resume_t.company = "Acme Corp."; 695 | title = "Tester"; 696 | start_date = date1; 697 | end_date = Some date2; 698 | } 699 | in 700 | let valid_job = { job with Resume_t.start_date = valid } in 701 | let invalid_job = { job with Resume_t.end_date = Some invalid } in 702 | let valid_experience = [ job; valid_job ] in 703 | let invalid_experience = [ job; invalid_job ] in 704 | check_experience valid_experience; 705 | check_experience invalid_experience 706 | ## () ## 707 | 708 | Output: 709 | 710 | \begin{verbatim} 711 | VALID: 712 | [ 713 | { 714 | "company": "Acme Corp.", 715 | "title": "Tester", 716 | "start_date": { "year": 2005, "month": 8, "day": 1 }, 717 | "end_date": { "year": 2006, "month": 3, "day": 22 } 718 | }, 719 | { 720 | "company": "Acme Corp.", 721 | "title": "Tester", 722 | "start_date": { "year": 2000, "month": 2, "day": 29 }, 723 | "end_date": { "year": 2006, "month": 3, "day": 22 } 724 | } 725 | ] 726 | INVALID: 727 | [ 728 | { 729 | "company": "Acme Corp.", 730 | "title": "Tester", 731 | "start_date": { "year": 2005, "month": 8, "day": 1 }, 732 | "end_date": { "year": 2006, "month": 3, "day": 22 } 733 | }, 734 | { 735 | "company": "Acme Corp.", 736 | "title": "Tester", 737 | "start_date": { "year": 2005, "month": 8, "day": 1 }, 738 | "end_date": { "year": 1900, "month": 0, "day": 0 } 739 | } 740 | ] 741 | \end{verbatim} 742 | 743 | Source code for this section: 744 | \url{https://github.com/MyLifeLabs/atdgen-tutorial/tree/master/validate} 745 | 746 | 747 | 748 | \section{Modularity: referring to type definitions from another ATD file} 749 | 750 | It is possible to define types that depend on types 751 | defined in other \texttt{.atd} files. 752 | The example below is self-explanatory. 753 | 754 | \texttt{part1.atd}: 755 | 756 | ## atd () ## 757 | type t = { x : int; y : int } 758 | ## () ## 759 | 760 | \texttt{part2.atd}: 761 | 762 | ## atd () ## 763 | type t1 = abstract 764 | (* 765 | Imports type t defined in file part1.atd. 766 | The local name is t1. Because the local name (t1) is different from the 767 | original name (t), we must specify the original name using t=. 768 | *) 769 | 770 | type t2 = t1 list 771 | ## () ## 772 | 773 | \texttt{part3.atd}: 774 | 775 | ## atd () ## 776 | type t2 = abstract 777 | 778 | type t3 = { 779 | name : string; 780 | ?data : t2 option; 781 | } 782 | ## () ## 783 | 784 | \texttt{main.ml}: 785 | 786 | ## ocaml () ## 787 | let v = { 788 | Part3_t.name = "foo"; 789 | data = Some [ 790 | { Part1_t.x = 1; y = 2 }; 791 | { Part1_t.x = 3; y = 4 }; 792 | ] 793 | } 794 | 795 | let () = 796 | Ag_util.Json.to_channel Part3_j.write_t3 stdout v; 797 | print_newline () 798 | ## () ## 799 | 800 | Output: 801 | 802 | \begin{verbatim} 803 | {"name":"foo","data":[{"x":1,"y":2},{"x":3,"y":4}]} 804 | \end{verbatim} 805 | 806 | Source code for this section: 807 | \url{https://github.com/MyLifeLabs/atdgen-tutorial/tree/master/modularity} 808 | 809 | 810 | \section{Managing JSON configuration files} 811 | 812 | JSON makes a good format for configuration files because it is 813 | human-readable, easy to modify programmatically and widespread. 814 | Here is an example of how to use atdgen to manage config files. 815 | 816 | \begin{itemize} 817 | \item \textbf{Specifying defaults} is done in the .atd file. See 818 | section \ref{defaults} for details on how to do that. 819 | \item \textbf{Auto-generating a template config file with default values}: 820 | a sample value in the OCaml world needs to be created but only 821 | fields without default need to be specified. 822 | \item \textbf{Describing the format} is achieved by embedding the .atd 823 | type definitions in the OCaml program and printing it out on request. 824 | \item \textbf{Loading a config file and reporting illegal fields} is 825 | achieved using the JSON deserializers produced by \texttt{atdgen 826 | -j}. Option \texttt{-j-strict-fields} ensures the misspelled field 827 | names are not ignored but reported as errors. 828 | \item \textbf{Reindenting a config file} is achieved by the 829 | pretty-printing function \texttt{Yojson.Safe.prettify} that takes a 830 | JSON string and returns an equivalent JSON string. 831 | \item \textbf{Showing implicit (default) settings} is achieved by 832 | passing the \texttt{-j-defaults} option to \texttt{atdgen}. 833 | The OCaml config data is then serialized into JSON containing all 834 | fields, including those whose value is the default. 835 | \end{itemize} 836 | 837 | The example uses the following type definitions: 838 | ## print_atd (file_contents "config-file/config.atd") ## 839 | 840 | Our program will perform the following actions: 841 | \begin{verbatim} 842 | $ ./config -template 843 | { 844 | "title": "", 845 | "timeout": 10, 846 | "credentials": [ { "name": "foo", "key": "0123456789abcdef" } ] 847 | } 848 | 849 | $ ./config -format 850 | type config = { 851 | title : string; 852 | ?description : string option; 853 | ~timeout : int; 854 | ~credentials : param list 855 | ; 857 | } 858 | 859 | type param = { 860 | name : string 861 | ; 862 | key : string 863 | ; 864 | } 865 | 866 | $ cat sample-config.json 867 | { 868 | "title": "Example", 869 | "credentials": [ 870 | { 871 | "name": "joeuser", 872 | "key": "db7c0877bdef3016" 873 | }, 874 | { 875 | "name": "tester", 876 | "key": "09871ff387ac2b10" 877 | } 878 | ] 879 | } 880 | 881 | $ ./config -validate sample-config.json 882 | { 883 | "title": "Example", 884 | "timeout": 10, 885 | "credentials": [ 886 | { "name": "joeuser", "key": "db7c0877bdef3016" }, 887 | { "name": "tester", "key": "09871ff387ac2b10" } 888 | ] 889 | } 890 | \end{verbatim} 891 | 892 | This is our \texttt{demo.sh} script that builds and runs our example 893 | program called \texttt{config}: 894 | \verbatiminput{config-file/demo.sh} 895 | 896 | This is the hand-written OCaml program. It can be used as a start 897 | point for a real-world program using a JSON config file: 898 | ## print_ocaml (file_contents "config-file/config.ml") ## 899 | 900 | The full source code for this section with examples can be inspected 901 | and downloaded here: 902 | \url{https://github.com/MyLifeLabs/atdgen-tutorial/tree/master/config-file} 903 | 904 | 905 | \section{Integration with ocamldoc} 906 | 907 | Ocamldoc is a tool that comes with the core OCaml distribution. 908 | It uses comments within \texttt{(**} and \texttt{*)} to produce 909 | hyperlinked documentation (HTML) of module signatures. 910 | 911 | Atdgen can produce \texttt{.mli} files with comments in the syntax supported by 912 | ocamldoc but regular ATD comments within \texttt{(*} and \texttt{*)} 913 | are always discarded 914 | by Atdgen. Instead, \texttt{} must be used and placed after the 915 | element they describe. The contents of the text field must be UTF8-encoded. 916 | 917 | ## atd () ## 918 | type point = { 919 | x : float; 920 | y : float; 921 | ~z 922 | 923 | : float; 924 | } 925 | 933 | ## () ## 934 | 935 | is converted into the following \texttt{.mli} file with 936 | ocamldoc-compatible comments: 937 | 938 | ## ocaml () ## 939 | (** 940 | Point with optional 3rd dimension. 941 | 942 | OCaml example: 943 | 944 | {v 945 | let p = 946 | \{ x = 0.5; y = 1.0; z = 0. \} 947 | v} 948 | *) 949 | type point = { 950 | x: float; 951 | y: float; 952 | z: float (** Optional depth, its default value is [0.0]. *) 953 | } 954 | ## () ## 955 | 956 | The only two forms of markup supported by \texttt{} 957 | are \texttt{\{\{} ... \texttt{\}\}} 958 | for inline code and \texttt{\{\{\{} ... \texttt{\}\}\}} for a block of 959 | preformatted code. 960 | 961 | 962 | \section{Integration with build systems} 963 | 964 | \subsubsection{OMake} 965 | 966 | We provide an 967 | \href{https://github.com/MyLifeLabs/atdgen-omake}{Atdgen 968 | plugin} for \href{http://omake.metaprl.org}{OMake}. 969 | It allows to simplify the compilation rules to a minimum. 970 | 971 | The plugin consists of a self-documented file to copy into a project's 972 | root. The following is a sample \texttt{OMakefile} for a project using JSON and 973 | five source files (\texttt{foo.atd}, \texttt{foo.ml}, 974 | \texttt{bar.atd}, \texttt{bar.ml} and \texttt{main.ml}): 975 | 976 | \begin{verbatim} 977 | include Atdgen 978 | # requires file Atdgen.om 979 | 980 | OCAMLFILES = foo_t foo_j foo bar_t bar_j bar main 981 | # correspond to the OCaml modules we want to build 982 | 983 | Atdgen(foo bar, -j-std) 984 | OCamlProgram(foobar, $(OCAMLFILES)) 985 | 986 | .DEFAULT: foobar.opt 987 | 988 | .PHONY: clean 989 | clean: 990 | rm -f *.cm[ioxa] *.cmx[as] *.[oa] *.opt *.run *~ 991 | rm -f $(ATDGEN_OUTFILES) 992 | \end{verbatim} 993 | 994 | Running \texttt{omake} builds the native code executable 995 | \texttt{foobar.opt}. 996 | 997 | \texttt{omake clean} removes all the products 998 | of compilation including the \texttt{.mli} and \texttt{.ml} produced 999 | by \texttt{atdgen}. 1000 | 1001 | 1002 | \subsubsection{GNU Make} 1003 | 1004 | We provide 1005 | \href{https://github.com/MyLifeLabs/atdgen-omake}{\texttt{Atdgen.mk}}, 1006 | a generic makefile that defines the 1007 | dependencies and rules for generating OCaml \texttt{.mli} and 1008 | \texttt{.ml} files from \texttt{.atd} files containing type 1009 | definitions. The \texttt{Atdgen.mk} file contains its own documentation. 1010 | 1011 | Here is a sample \texttt{Makefile} that takes advantage of 1012 | \href{http://www.ocaml.info/home/ocaml\_sources.html\#ocaml-make}{\texttt{OCamlMakefile}}: 1013 | \begin{verbatim} 1014 | .PHONY: default 1015 | default: opt 1016 | 1017 | ATDGEN_SOURCES = foo.atd bar.atd 1018 | ATDGEN_FLAGS = -j-std 1019 | include Atdgen.mk 1020 | 1021 | SOURCES = \ 1022 | foo_t.mli foo_t.ml foo_j.mli foo_j.ml \ 1023 | bar_t.mli bar_t.ml bar_j.mli bar_j.ml \ 1024 | hello.ml 1025 | RESULT = hello 1026 | PACKS = atdgen 1027 | # "include OCamlMakefile" must come after defs for SOURCES, RESULT, PACKS, etc. 1028 | include OCamlMakefile 1029 | 1030 | .PHONY: sources opt all 1031 | sources: $(SOURCES) 1032 | opt: sources 1033 | $(MAKE) native-code 1034 | all: sources 1035 | $(MAKE) byte-code 1036 | \end{verbatim} 1037 | 1038 | \texttt{make} alone builds a native code executable from source files 1039 | \texttt{foo.atd}, \texttt{bar.atd} and \texttt{hello.ml}. 1040 | \texttt{make clean} removes generated files. \texttt{make all} builds 1041 | a bytecode executable. 1042 | In addition to \texttt{native-code}, \texttt{byte-code} and 1043 | \texttt{clean}, \texttt{OCamlMakefile} provides a number of other targets 1044 | and options which are documented in \texttt{OCamlMakefile}'s README. 1045 | 1046 | \subsubsection{Ocamlbuild} 1047 | 1048 | Rule to add in \texttt{myocamlbuild.ml}: 1049 | \begin{verbatim} 1050 | let _ = dispatch begin function 1051 | | After_rules -> rule "atdgen: .atd -> _t.ml*, _j.ml*" 1052 | ~prods:["%_t.ml";"%_t.mli";"%_j.ml";"%_j.mli";"%_v.ml";"%_v.mli";] 1053 | ~dep:"%.atd" 1054 | (fun env build -> 1055 | let atdgen = "atdgen" in 1056 | Seq [ 1057 | Cmd (S [A atdgen; A "-t"; P (env "%.atd")]); 1058 | Cmd (S [A atdgen; A "-j"; A "-j-std"; P (env "%.atd")]); 1059 | Cmd (S [A atdgen; A "-v"; P (env "%.atd")]); 1060 | ] 1061 | ); 1062 | end 1063 | \end{verbatim} 1064 | 1065 | Flag to add in \texttt{_tags} file: 1066 | \begin{verbatim} 1067 | <*.{ml,mli,byte,native}>:package(atdgen),package(biniou) 1068 | \end{verbatim} 1069 | --------------------------------------------------------------------------------