├── .gitignore ├── .merlin ├── .ocp-indent ├── .travis.yml ├── CHANGES.md ├── README.md ├── assemble.ml ├── attic ├── 401 │ └── asd_ocaml_incl.ml ├── 402 │ └── asd_ocaml_incl.ml ├── asd_cstub.ml ├── asd_cstub.mli ├── asd_ocaml.ml ├── asd_ocaml.mli └── ctypes_gen.ml ├── bootstrap.sh ├── doc ├── bootstrap.sh └── style.css ├── driver ├── builder_makefile.ml ├── builder_makefile.mli ├── cmd_base.ml ├── cmd_base.mli ├── cmd_build.ml ├── cmd_build.mli ├── cmd_describe.ml ├── cmd_describe.mli ├── cmd_help.ml ├── cmd_help.mli ├── cmd_product.ml ├── cmd_product.mli ├── cmd_setup.ml ├── cmd_setup.mli ├── main.ml ├── makefile.ml └── makefile.mli ├── examples ├── camlp4 │ ├── assemble.ml │ └── t.ml ├── containers │ ├── a.ml │ ├── assemble.ml │ └── b.ml ├── cstubs │ ├── assemble.ml │ ├── date_bindings.ml │ └── date_cmd.ml ├── ctypes-libffi │ ├── assemble.ml │ └── main.ml ├── gen-quine │ ├── assemble.ml │ └── quine.ml ├── hello │ ├── assemble.ml │ └── main.ml ├── multi-libs │ ├── a │ │ ├── a.ml │ │ ├── a1.ml │ │ └── s.mli │ ├── assemble.ml │ ├── b │ │ ├── b.ml │ │ └── c.ml │ └── foo.ml ├── pack │ ├── assemble.ml │ └── src │ │ ├── a.ml │ │ ├── b │ │ ├── a.ml │ │ └── c.ml │ │ └── main.ml ├── threads-lib │ ├── assemble.ml │ ├── tlib.ml │ └── tlib.mli └── threads │ ├── assemble.ml │ └── main.ml ├── lib-driver ├── assemblage_driver.ml ├── assemblage_driver.mli ├── assemblage_tools.ml ├── assemblage_tools.mli ├── ast_merlin.ml ├── ast_merlin.mli ├── ast_meta.ml ├── ast_meta.mli ├── ast_opam.ml └── ast_opam.mli ├── lib ├── as_acmd.ml ├── as_acmd.mli ├── as_action.ml ├── as_action.mli ├── as_action_ocaml.ml ├── as_action_ocaml.mli ├── as_args.ml ├── as_args.mli ├── as_conf.ml ├── as_conf.mli ├── as_ctx.ml ├── as_ctx.mli ├── as_misc.ml ├── as_misc.mli ├── as_ocamlfind.ml ├── as_ocamlfind.mli ├── as_part.ml ├── as_part.mli ├── as_part_bin.ml ├── as_part_bin.mli ├── as_part_dir.ml ├── as_part_dir.mli ├── as_part_doc.ml ├── as_part_doc.mli ├── as_part_lib.ml ├── as_part_lib.mli ├── as_part_pkg.ml ├── as_part_pkg.mli ├── as_part_run.ml ├── as_part_run.mli ├── as_part_unit.ml ├── as_part_unit.mli ├── as_pkg_config.ml ├── as_pkg_config.mli ├── as_project.ml ├── as_project.mli ├── as_univ.ml ├── as_univ.mli ├── as_vcs.ml ├── as_vcs.mli ├── assemblage.ml └── assemblage.mli ├── opam └── test └── builtin-keys └── test.ml /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | doc/*.html 3 | META 4 | Makefile 5 | *.install -------------------------------------------------------------------------------- /.merlin: -------------------------------------------------------------------------------- 1 | # assemblage 51d698d -- generated by assemblage %%VERSION%% 2 | 3 | PKG assemblage 4 | PKG rresult 5 | PKG astring 6 | PKG fmt 7 | PKG bos 8 | PKG bytes 9 | PKG cmdliner 10 | PKG compiler-libs.toplevel 11 | S driver 12 | S lib 13 | S lib-driver 14 | B _build/bin-assemblage 15 | B _build/dir-lib 16 | B _build/lib-assemblage 17 | B _build/lib-assemblage_driver 18 | B _build/lib-assemblage_tools 19 | -------------------------------------------------------------------------------- /.ocp-indent: -------------------------------------------------------------------------------- 1 | strict_with=always,match_clause=4,strict_else=never -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: c 2 | install: wget https://raw.githubusercontent.com/ocaml/ocaml-travisci-skeleton/master/.travis-opam.sh 3 | script: bash -ex .travis-opam.sh 4 | env: 5 | - OCAML_VERSION=4.02.0 6 | - OCAML_VERSION=4.01.0 7 | - OCAML_VERSION=4.00.1 8 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | 2 | # 0.4.0: [trunk] 3 | - Fix regression in the generation of docs 4 | - Merlin .merlin file generation 5 | 6 | # 0.3.0: [2014-08] 7 | - #43 Simpler and saner command-line options handling. 8 | Use `--feature=[true|false]` instead of --[enable|disable]-feature 9 | - #63 Remove the big recursive module in As_project: that makes the code simpler 10 | and easier to maintain and extend 11 | - #66 Rename the `Dir` component to `Container` to better reflect its semantics 12 | - #55, #74 Unify `configure.ml` and `describe.ml` into an unique `assemblage` 13 | command-line tool 14 | - #65 The `Dir` argument became `Path` and now takes a list of directory names 15 | - Remove the dependency to `camlp4`: do not depend on `optcomp` anymore but 16 | instead use the "linking trick" to include a different directory depending 17 | on the version of the compiler. Also, use the generated Makefiles now use the 18 | newly released `ocaml-dumpast` when it is available to dump the parsetree 19 | instead of calling `camlp4`. Use `assemble setup --no-dumpast` to continue 20 | to always use `camlp4`. 21 | - Fix a linking bug when building a binary with multiple files 22 | - Do not generate an empty META file when there is no library in the project 23 | - Fix a bug in the dependency tracking, now only the dependency of the modified 24 | files are re-computed 25 | - Use ASSEMBLAGE_UTF8_MSGS to have a nice wine emoji 26 | - Better startup procedure: `assemble.ml` now needs to call the code to parse 27 | the command-line (`Assemble.assemble`), which also means that that file can be 28 | compiled to a self-contained native binary if needed. 29 | - Faster and simpler bootstrap procedure 30 | - Add a `Doc` component 31 | 32 | # 0.2.0: [2014-08] 33 | 34 | - #54 No more mutation in the underlying component graph 35 | - #52 Unify the compilation units, with different kinds: they can be OCaml, 36 | C or Js 37 | - #50 Generalise the `Other' components to be similar to a Makefile rule 38 | - (almost) all the components can now take an `Other' as argument to express the 39 | fact that they can be generated 40 | - #38 We still have a static collection of components, but their 41 | inter-dependencies is computed dynamically, as you don't want to run 42 | `./configure` every time you change a dependency between modules. 43 | - #24 Be always explicit when creating a library and a binary to let the user 44 | specify the order in which component units should be linked 45 | - For each compilation unit, apply the pre-processors only once at the beginning 46 | of the build process 47 | - Move most of the compilation rules in As_project instead of As_makefile and 48 | make it generic enough to be used by other tools 49 | - Be more explicit in the type describing the different compilation phases and 50 | the different files 51 | 52 | # 0.1.0: [2014-07] 53 | - Initial release to get early feedback. 54 | - Support for simple to medium projects 55 | - Not working: the C stub generation does not work completely 56 | - Not working: no release hooks 57 | - Not working: the .js files are not installed 58 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ## Assemblage 2 | 3 | > __Assemblage__ is an artistic process. In the visual arts, it 4 | consists of making three-dimensional or two-dimensional artistic 5 | compositions by putting together found objects. 6 | [wikipedia](http://en.wikipedia.org/wiki/Assemblage_(art)) 7 | 8 | The *Assemblage* toolbox provides an API and a set of binaries to 9 | setup, manage, and use OCaml projects. 10 | 11 | ### Status 12 | 13 | [![Build Status](https://travis-ci.org/samoht/assemblage.svg?branch=master)](https://travis-ci.org/samoht/assemblage) 14 | 15 | The library can be used to describe OCaml projects with static dependencies. 16 | 17 | The latest public documentation is available [here](http://samoht.github.io/assemblage/Assemblage.html). 18 | 19 | A projects description consists of a list of libraries, binaries 20 | and/or toplevels. Each containing a list of compilation units with 21 | precise (and static) dependency relationships. 22 | 23 | Using a project description, the tools can generate: 24 | 25 | - a `.merlin` to help edit the project; 26 | - a `Makefile` to build the project; 27 | - a `.install` to install the project; and 28 | - a `META` file to use the project. 29 | 30 | ### Dependency Tracking 31 | 32 | Multiple kinds of dependencies are currently supported: 33 | 34 | - a single directory, with a collection of files to sort to form a 35 | library (using ocamldep) 36 | - local libraries, defined in the same project 37 | - local syntax extensions, defined in the same project (using `camlp4o`) 38 | - global ocamlfind libraries 39 | - global ocamlfind syntax extensions (using `camlp4o`) 40 | 41 | ### Project Flags 42 | 43 | Every project is parametrized by a set of flags, which will determine 44 | sub-parts of the project to be built (and installed) or not. The flag 45 | can be enabled or disabled either programmatically (ie. in the project 46 | description itself) or passed on the command-line using an integrated 47 | `Cmdliner` interface. 48 | 49 | ### Examples 50 | 51 | The interaction with the system occurs through the `assemblage` tool 52 | which has the `setup` and `describe` sub-commands. `setup` 53 | reads a project description (usually, an `assemble.ml` file located at 54 | the root of the project) and generates the boilerplate files to build, 55 | install and use the project. `describe` simply displays a summary 56 | of the project: 57 | 58 | ```shell 59 | thomas@piana:~/git/assemblage$ assemblage describe 60 | ==> Loading assemble.ml 61 | 62 | ==> assemblage 3b27e2 63 | └─┬─ lib-assemblage 64 | ├─── [cmdliner] 65 | ├─ as_shell.ml as_shell.mli 66 | ├─ as_git.ml as_git.mli 67 | ├─ as_makefile.ml as_makefile.mli 68 | ├─── Rule 69 | ├─── Var 70 | ├─ as_features.ml as_features.mli 71 | ├─── Set 72 | ├─ as_flags.ml as_flags.mli 73 | ├─── PhaseSet 74 | ├─ as_resolver.ml as_resolver.mli 75 | ├─ as_build_env.ml as_build_env.mli 76 | ├─ as_action.ml as_action.mli 77 | ├─── FileSet 78 | ├─ as_component.ml as_component.mli 79 | ├─── Bin 80 | ├─── Container 81 | ├─── Doc 82 | ├─── Lib 83 | ├─── Other 84 | ├─── Pkg 85 | ├─── Rule 86 | ├─── Set 87 | ├─── Test 88 | ├─── Unit 89 | ├─ as_project.ml as_project.mli 90 | ├─ as_opam.ml as_opam.mli 91 | ├─── Install 92 | ├─ as_merlin.ml as_merlin.mli 93 | ├─── Directive 94 | ├─ as_ocamlfind.ml as_ocamlfind.mli 95 | ├─── META 96 | ├─ as_project_makefile.mlas_project_makefile.mli 97 | ├─ as_OCaml_incl.ml 98 | ├─── Pparse 99 | ├─── StringSet 100 | ├─ as_OCaml.ml as_OCaml.mli 101 | ├─ as_env.ml as_env.mli 102 | ├─ as_tool.ml as_tool.mli 103 | ├─ as_cmd.ml as_cmd.mli 104 | ├─ assemblage.ml assemblage.mli 105 | ├─── Action 106 | ├─── Build_env 107 | ├─── Features 108 | ├─── Flags 109 | └─── Resolver 110 | └─┬─ bin-assemblage 111 | └─ tool.ml 112 | └─┬─ bin-ctypes-gen 113 | └─ ctypes_gen.ml 114 | └─┬─ bin-assemble 115 | └─ assemble.ml 116 | ``` 117 | 118 | You can find few examples in the `examples/` directory, where projects 119 | are built using multiple local libraries and ocamlfind libraries and 120 | syntax extensions. 121 | -------------------------------------------------------------------------------- /assemble.ml: -------------------------------------------------------------------------------- 1 | open Assemblage 2 | 3 | (* Configuration schemes *) 4 | 5 | let dev = Conf.scheme "dev" ~doc:"Convenience scheme for development." 6 | [ Conf.def Conf.debug true; 7 | Conf.def Conf.warn_error true; 8 | Conf.def Conf.doc true;] 9 | 10 | let schemes = [ dev ] 11 | 12 | (* Arguments *) 13 | 14 | let args = Args.empty 15 | 16 | (* OCamlfind packages *) 17 | 18 | let pkg_cmdliner = pkg "cmdliner" 19 | let pkg_bytecomp = pkg "compiler-libs.bytecomp" 20 | let pkg_toplevel = pkg "compiler-libs.toplevel" 21 | let pkg_bytes = pkg "bytes" 22 | 23 | (* Libraries *) 24 | 25 | let lib_assemblage = 26 | let dir = root / "lib" in 27 | let kind = `OCaml (`Both, `Hidden) in 28 | let unit ?needs ?(kind = kind) name = unit ?needs ~kind name ~dir in 29 | lib "assemblage" 30 | [ unit "as_univ"; 31 | unit "as_string"; 32 | unit "as_fmt"; 33 | unit "as_path"; 34 | unit "as_log"; 35 | unit "as_cmd" ~needs:[pkg_bytes]; 36 | unit "as_conf"; 37 | unit "as_ctx"; 38 | unit "as_args"; 39 | unit "as_acmd"; 40 | unit "as_action"; 41 | unit "as_action_ocaml"; 42 | unit "as_ocamlfind"; 43 | unit "as_pkg_config"; 44 | unit "as_part"; 45 | unit "as_part_lib"; 46 | unit "as_part_pkg"; 47 | unit "as_part_unit"; 48 | unit "as_part_doc"; 49 | unit "as_part_bin"; 50 | unit "as_part_dir"; 51 | unit "as_part_run"; 52 | unit "as_project"; 53 | unit "assemblage" ~kind:(`OCaml (`Both, `Normal)) ] 54 | 55 | let lib_assemblage_tools = 56 | let dir = root / "lib-driver" in 57 | let kind = `OCaml (`Both, `Hidden) in 58 | let unit ?needs ?(kind = kind) name = unit ?needs ~kind name ~dir in 59 | lib "assemblage_tools" 60 | [ lib_assemblage; 61 | unit "ast_merlin"; 62 | unit "ast_meta"; 63 | unit "ast_opam"; 64 | unit "assemblage_tools" ~kind:(`OCaml (`Both, `Normal))] 65 | 66 | let lib_assemblage_driver = 67 | let dir = root / "lib-driver" in 68 | lib "assemblage_driver" [ 69 | pkg_cmdliner; 70 | pkg_toplevel; 71 | lib_assemblage; 72 | unit ~dir "assemblage_driver" ~needs:[pkg_cmdliner; pkg_toplevel]; 73 | ] 74 | 75 | (* The default assemblage driver *) 76 | 77 | let bin_assemblage = 78 | let dir = root / "driver" in 79 | let unit ?needs ?kind name = unit ?needs ?kind name ~dir in 80 | bin "assemblage" ~native:false ~args:Args.linkall [ 81 | pkg_cmdliner; 82 | pkg_toplevel; 83 | lib_assemblage; 84 | lib_assemblage_tools; 85 | lib_assemblage_driver; 86 | unit "makefile"; 87 | unit "builder_makefile"; 88 | unit "cmd_base" ~needs:[pkg_cmdliner]; 89 | unit "cmd_build"; 90 | unit "cmd_describe"; 91 | unit "cmd_product"; 92 | unit "cmd_help"; 93 | unit "cmd_setup"; 94 | unit "main" ~kind:(`OCaml (`Ml, `Normal)); 95 | ] 96 | 97 | (* Tests & examples *) 98 | 99 | let assemble_assemble = 100 | (* Sanity check, can we compile assemble.ml ? *) 101 | bin "assemble" [ lib_assemblage; unit "assemble" ~dir:root ] 102 | 103 | let mk_test ?(example = false) name = 104 | let dir = root / (if example then "examples" else "test") / name in 105 | let lib_dir = Conf.(value root_dir) // Part.root lib_assemblage in 106 | let make args = Acmd.v (Acmd.static "make") args in 107 | let cmds lib_dir assemblage = 108 | let assemblage sub args = 109 | let args = "--auto-lib=false" :: "-I" :: Path.to_string lib_dir :: args in 110 | Acmd.v assemblage (sub :: args) 111 | in 112 | [ assemblage "describe" []; 113 | assemblage "setup" []; 114 | make []; 115 | make ["distclean"]] 116 | in 117 | let cmds = Conf.(const cmds $ lib_dir) in 118 | Run.with_bin ~usage:`Test ~dir ~name bin_assemblage cmds 119 | 120 | let mk_example = mk_test ~example:true 121 | 122 | let tests = 123 | [ mk_test "builtin-keys"; 124 | mk_example "hello"; 125 | mk_example "gen-quine"; 126 | mk_example "camlp4"; 127 | mk_example "multi-libs"; 128 | mk_example "containers"; 129 | mk_example "pack"; 130 | mk_example "threads"; 131 | mk_example "threads-lib"; 132 | mk_example "ctypes-libffi"; ] 133 | 134 | (* Docs *) 135 | 136 | let dev_doc = doc ~usage:`Dev "dev" [ lib_assemblage ] 137 | let api_doc = doc "api" [ lib_assemblage ] 138 | 139 | let install = 140 | [ dir `Lib [ lib_assemblage; lib_assemblage_tools; lib_assemblage_driver ]; 141 | dir `Bin [ bin_assemblage ]; 142 | dir `Doc [ file (Path.v "README.md"); file (Path.v "CHANGES.md") ]] 143 | 144 | (* The project *) 145 | 146 | let parts = 147 | [ lib_assemblage; lib_assemblage_tools; lib_assemblage_driver; 148 | bin_assemblage; dev_doc; api_doc ] @ install @ tests 149 | 150 | let () = assemble @@ Project.v "assemblage" ~args ~schemes ~parts 151 | -------------------------------------------------------------------------------- /attic/401/asd_ocaml_incl.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | open Parsetree 18 | 19 | module Pparse = struct 20 | include Pparse 21 | (* from `ocaml-4.02/driver/pparse.ml' *) 22 | let parse_all ~tool_name:_ parse_fun magic ppf sourcefile = 23 | Location.input_name := sourcefile; 24 | let inputfile = Pparse.preprocess sourcefile in 25 | let ast = 26 | try Pparse.file ppf (*~tool_name*) inputfile parse_fun magic 27 | with exn -> 28 | Pparse.remove_preprocessed inputfile; 29 | raise exn 30 | in 31 | Pparse.remove_preprocessed inputfile; 32 | ast 33 | let parse_implementation ppf ~tool_name sourcefile = 34 | parse_all Parse.implementation ~tool_name Config.ast_impl_magic_number ppf 35 | sourcefile 36 | let parse_interface ppf ~tool_name sourcefile = 37 | parse_all Parse.interface ~tool_name Config.ast_intf_magic_number ppf sourcefile 38 | end 39 | 40 | let add_module prefix set m = 41 | let p = prefix m in 42 | As_string.Set.add p set, fun x -> p ^ "." ^ x 43 | 44 | let modules_of_ml ast = 45 | let rec structure_item prefix acc { pstr_desc; _ } = 46 | match pstr_desc with 47 | | Pstr_module (l, e) -> 48 | let acc, prefix = add_module prefix acc l.Asttypes.txt in 49 | module_expr prefix acc e.pmod_desc 50 | | Pstr_recmodule l -> 51 | List.fold_left (fun acc (l,_,e) -> 52 | let acc, prefix = add_module prefix acc l.Asttypes.txt in 53 | module_expr prefix acc e.pmod_desc 54 | ) acc l 55 | | _ -> acc 56 | and module_expr prefix acc = function 57 | | Pmod_structure l -> List.fold_left (structure_item prefix) acc l 58 | | _ -> acc 59 | in 60 | List.fold_left (structure_item (fun x -> x)) As_string.Set.empty ast 61 | 62 | let modules_of_mli ast = 63 | let rec sig_item prefix acc { psig_desc; _ } = 64 | match psig_desc with 65 | | Psig_module (l, s) -> 66 | let acc, prefix = add_module prefix acc l.Asttypes.txt in 67 | module_type prefix acc s 68 | | Psig_recmodule l -> 69 | List.fold_left (fun acc (l,s) -> 70 | let acc, prefix = add_module prefix acc l.Asttypes.txt in 71 | module_type prefix acc s 72 | ) acc l 73 | | _ -> acc 74 | and module_type prefix acc { pmty_desc; _ } = 75 | match pmty_desc with 76 | | Pmty_signature s -> List.fold_left (sig_item prefix) acc s 77 | | _ -> acc 78 | in 79 | List.fold_left (sig_item (fun x -> x)) As_string.Set.empty ast 80 | -------------------------------------------------------------------------------- /attic/402/asd_ocaml_incl.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | open Parsetree 18 | 19 | let add_module prefix set m = 20 | let p = prefix m in 21 | As_string.Set.add p set, fun x -> p ^ "." ^ x 22 | 23 | let modules_of_ml ast = 24 | let rec structure_item prefix acc { pstr_desc; _ } = 25 | match pstr_desc with 26 | | Pstr_module b -> 27 | let acc, prefix = add_module prefix acc b.pmb_name.Asttypes.txt in 28 | module_expr prefix acc b.pmb_expr.pmod_desc 29 | | Pstr_recmodule l -> 30 | List.fold_left (fun acc b -> 31 | let acc, prefix = add_module prefix acc b.pmb_name.Asttypes.txt in 32 | module_expr prefix acc b.pmb_expr.pmod_desc 33 | ) acc l 34 | | _ -> acc 35 | and module_expr prefix acc = function 36 | | Pmod_structure l -> List.fold_left (structure_item prefix) acc l 37 | | _ -> acc 38 | in 39 | List.fold_left (structure_item (fun x -> x)) As_string.Set.empty ast 40 | 41 | let modules_of_mli ast = 42 | let rec sig_item prefix acc { psig_desc; _ } = 43 | match psig_desc with 44 | | Psig_module b -> 45 | let acc, prefix = add_module prefix acc b.pmd_name.Asttypes.txt in 46 | module_type prefix acc b.pmd_type 47 | | Psig_recmodule l -> 48 | List.fold_left (fun acc b -> 49 | let acc, prefix = add_module prefix acc b.pmd_name.Asttypes.txt in 50 | module_type prefix acc b.pmd_type 51 | ) acc l 52 | | _ -> acc 53 | and module_type prefix acc { pmty_desc; _ } = 54 | match pmty_desc with 55 | | Pmty_signature s -> List.fold_left (sig_item prefix) acc s 56 | | _ -> acc 57 | in 58 | List.fold_left (sig_item (fun x -> x)) As_string.Set.empty ast 59 | -------------------------------------------------------------------------------- /attic/asd_cstub.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | 18 | 19 | let cstubs ?available ?(deps = []) ?(headers = []) ?(cflags = []) ?(clibs = []) 20 | name ~dir 21 | = 22 | let name_bindings = name ^ "_bindings" in 23 | let name_stubs = name ^ "_stubs" in 24 | 25 | (* 1. compile the bindings. *) 26 | let deps = `Pkg As_part.Pkg.ctypes_stub :: deps in 27 | let bindings = unit name_bindings (`Path path) ~deps in 28 | 29 | (* 2. compile the generator of _stubs.{ml,c} and .ml *) 30 | let generator = 31 | let name_generator = name ^ "_generator" in 32 | let ctypes_gen = 33 | other (name ^ "-generator") [ 34 | As_action.rule 35 | ~phase:`Prepare 36 | ~targets:[`Self `Ml] 37 | ~prereqs:[] 38 | (fun _t r _f -> 39 | let dir = As_part.build_dir bindings r in 40 | let ml_stubs = dir / name_stubs ^ ".ml" in 41 | let c_stubs = dir / name_stubs ^ ".c" in 42 | let library = dir / name ^ ".ml" in 43 | let headers = match headers with 44 | | [] -> "" 45 | | hs -> sprintf "--headers %s " (String.concat "," hs) in 46 | As_action.create ~dir 47 | "ctypes-gen %s--ml-stubs %s --c-stubs %s --library %s %s" 48 | headers ml_stubs c_stubs library name) 49 | ] in 50 | let unit = unit name_generator ctypes_gen in 51 | bin name_generator (`Units [unit]) 52 | in 53 | 54 | (* 3. compile the generated stubs *) 55 | let run_generator = 56 | other (name ^ "-generator.run") [ 57 | As_action.rule 58 | ~phase:`Prepare 59 | ~targets:[`Self `Ml; `Self `C] 60 | ~prereqs:[`N (generator, `Byte)] 61 | (fun t r _f -> 62 | let dir = As_part.build_dir t r in 63 | As_action.create ~dir "./%s.byte" (As_part.name t)) 64 | ] in 65 | let ml_stubs = unit name_stubs run_generator ~deps:[bindings] in 66 | let c_stubs = c name_stubs run_generator in 67 | let main = unit name run_generator ~deps:[ml_stubs; c_stubs] in 68 | 69 | (* 4. compile the main library *) 70 | let flags = 71 | let link_flags = cflags @ List.map (sprintf "-l%s") clibs in 72 | As_flags.(cclib link_flags @@@ stub name_stubs) in 73 | (* FIXME: which action ? *) 74 | lib name ~flags ?available (`Units [bindings; ml_stubs; c_stubs; main]) 75 | -------------------------------------------------------------------------------- /attic/asd_cstub.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | val cstubs : ?available:bool As_conf.value -> ?deps:'a As_part.t list -> 18 | ?headers:string list -> ?cflags:string list -> ?clibs:string list -> 19 | string -> dir:string list -> [> `Lib] As_part.t 20 | (** [stubs name dir] is the C stub generations, using Ctypes, of the 21 | compilation unit [name]. The [Name_bindings] module should be 22 | located in [dir]. *) 23 | -------------------------------------------------------------------------------- /attic/asd_ocaml.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | let str = Printf.sprintf 18 | open Asd_ocaml_incl 19 | 20 | let init args = 21 | match As_args.get (`Pp `Byte) args with 22 | | [] -> Clflags.preprocessor := None; 23 | | pp -> 24 | let pp = String.concat " " pp in 25 | Clflags.preprocessor := Some (str "camlp4o %s" pp) 26 | 27 | let modules ~build_dir unit = [] 28 | let r = As_ocamlfind.resolver `Direct ~build_dir () in 29 | let () = init (As_part.flags (`Unit unit) r) in 30 | let aux ext = 31 | let source = 32 | As_part.source_dir (`Unit unit) (ext :> As_action.file) 33 | in 34 | let build = 35 | As_part.source_dir (`Unit unit) (ext :> As_action.file) 36 | in 37 | let parse f = match ext with 38 | | `Ml -> modules_of_ml (Pparse.parse_implementation ~tool_name:"" 39 | Format.err_formatter f) 40 | | `Mli -> modules_of_mli (Pparse.parse_interface ~tool_name:"" 41 | Format.err_formatter f) 42 | in 43 | if Sys.file_exists source then parse source else 44 | if Sys.file_exists build then parse build else 45 | As_string.Set.empty 46 | in 47 | let set = 48 | if As_part.products `Mli unit then aux `Mli 49 | else if As_part.Unit.has `Ml unit then aux `Ml 50 | else As_string.Set.empty in 51 | As_string.Set.elements set 52 | -------------------------------------------------------------------------------- /attic/asd_ocaml.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | (** Compiler-libs helpers. *) 18 | 19 | val modules : build_dir:string -> [`Unit] As_part.t -> string list 20 | (** Return the list of submodules defined in the given compilation unit. *) 21 | -------------------------------------------------------------------------------- /attic/ctypes_gen.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | open Cmdliner 18 | open Printf 19 | 20 | let headers = 21 | let doc = Arg.info 22 | ~docv:"FILE" 23 | ~doc:"List of C headers to include in the generated C stubs." 24 | ["headers"] in 25 | Arg.(value & opt (list string) [] & doc) 26 | 27 | let project_name = 28 | let doc = Arg.info 29 | ~docv:"MODULE" 30 | ~doc:"The name of the library for which the user wrote some binding." 31 | [] in 32 | Arg.(required & pos 0 (some string) None & doc) 33 | 34 | let default_name = "$(b,NAME)" 35 | 36 | type t = 37 | { 38 | default: string; 39 | mk: string -> string; 40 | term: string Term.t; 41 | } 42 | 43 | let ml_stubs = 44 | let mk = sprintf "%s_stubs.ml" in 45 | let default = mk default_name in 46 | let doc = Arg.info 47 | ~docv:"FILE" 48 | ~doc:"The name of the stub `.ml` file which will be generated." 49 | ["ml-stubs"] in 50 | let term = Arg.(value & opt string default & doc) in 51 | { default; mk; term } 52 | 53 | let c_stubs = 54 | let mk = sprintf "%s_stubs.c" in 55 | let default = mk default_name in 56 | let doc = Arg.info 57 | ~docv:"FILE" 58 | ~doc:"The name of the stub `.c` file which will be generated." 59 | ["c-stubs"] in 60 | let term = Arg.(value & opt string default & doc) in 61 | { default; mk; term } 62 | 63 | let funct = 64 | let mk x = sprintf "%s_bindings.Make" (String.capitalize x) in 65 | let default = mk default_name in 66 | let doc = Arg.info 67 | ~docv:"FUNCTOR" 68 | ~doc:"The name of the functor which defined the Ctypes bindings." 69 | ["functor"] in 70 | let term = Arg.(value & opt string default & doc) in 71 | { default; mk; term } 72 | 73 | let generator = 74 | let mk = sprintf "%s_generator.ml" in 75 | let default = mk default_name in 76 | let doc = Arg.info 77 | ~docv:"FILE" 78 | ~doc:"The name of the generator source file." 79 | ["generator"] in 80 | let term = Arg.(value & opt string default & doc) in 81 | { default; mk; term } 82 | 83 | let library = 84 | let mk x = x ^ ".ml" in 85 | let default = mk default_name in 86 | let doc = Arg.info 87 | ~docv:"FILE" 88 | ~doc:"The name of the library file." 89 | ["library"] in 90 | let term = Arg.(value & opt string default & doc) in 91 | { default; mk; term } 92 | 93 | let output_generator_ml 94 | headers ml_stubs_ c_stubs_ funct_ generator_ library_ name = 95 | let mk t x = if x = t.default then t.mk name else x in 96 | let ml_stubs = mk ml_stubs ml_stubs_ in 97 | let c_stubs = mk c_stubs c_stubs_ in 98 | let funct = mk funct funct_ in 99 | let generator = mk generator generator_ in 100 | let library = mk library library_ in 101 | let buf = Buffer.create 1024 in 102 | let p fmt = bprintf buf (fmt ^^ "\n") in 103 | p "(* Generated by Assemblage *)"; 104 | p "let c_headers = ["; 105 | List.iter (p " \"#include <%s.h>\";") headers; 106 | p "]"; 107 | p ""; 108 | p "let main () ="; 109 | if Filename.dirname ml_stubs <> "." then 110 | p " let _ = Sys.command \"mkdir -p %s\" in" (Filename.dirname ml_stubs); 111 | if Filename.dirname ml_stubs <> Filename.dirname c_stubs then 112 | p " let _ = Sys.command \"mkdir -p %s\" in" (Filename.dirname c_stubs); 113 | p " let ml_out = open_out \"%s\"" ml_stubs; 114 | p " and c_out = open_out \"%s\" in" c_stubs; 115 | p " let ml_fmt = Format.formatter_of_out_channel ml_out"; 116 | p " and c_fmt = Format.formatter_of_out_channel c_out in"; 117 | p " List.iter (Format.fprintf c_fmt \"%%s@\\n\") c_headers;"; 118 | p " Cstubs.write_c c_fmt ~prefix:\"%s_stub_\" (module %s);" name funct; 119 | p " Cstubs.write_ml ml_fmt ~prefix:\"%s_stub_\" (module %s);" name funct; 120 | p " Format.pp_print_flush ml_fmt ();"; 121 | p " Format.pp_print_flush c_fmt ();"; 122 | p " close_out ml_out;"; 123 | p " close_out c_out"; 124 | p ""; 125 | p "let () = main ()"; 126 | p ""; 127 | 128 | let oc = open_out generator in 129 | output_string oc (Buffer.contents buf); 130 | close_out oc; 131 | let bindings = 132 | try 133 | let i = String.index funct '.' in 134 | String.sub funct 0 i 135 | with Not_found -> Assemblage.Log.err "%s is not a functor!" funct; exit 1 136 | in 137 | let stubs = String.capitalize Filename.(basename (chop_extension ml_stubs)) in 138 | let oc = open_out library in 139 | output_string oc "(* Generated by Assemblage. *)\n\n"; 140 | output_string oc (sprintf "include %s\n" bindings); 141 | output_string oc (sprintf "include %s(%s)\n" funct stubs); 142 | close_out oc 143 | 144 | let () = 145 | let term = 146 | Term.(pure output_generator_ml 147 | $ headers $ ml_stubs.term $ c_stubs.term 148 | $ funct.term $ generator.term $ library.term 149 | $ project_name) in 150 | let info = Term.info 151 | ~version:"0.1" 152 | ~doc:"Helper for Ctype stubs generation." 153 | ~man:[] 154 | "ctype-gen" in 155 | match Term.eval (term, info) with 156 | | `Ok conf -> conf 157 | | `Version -> exit 0 158 | | `Help -> exit 0 159 | | `Error _ -> exit 1 160 | -------------------------------------------------------------------------------- /bootstrap.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | set -ex 4 | 5 | OCAMLFIND=${OCAMLFIND:="ocamlfind"} 6 | 7 | BDIR="_build/bootstrap" 8 | PKGS="-package bytes -package rresult -package astring -package fmt \ 9 | -package bos -package cmdliner" 10 | CMOS="" 11 | 12 | # Make sure $BDIR is clean 13 | rm -rf $BDIR 14 | mkdir -p $BDIR 15 | 16 | # FIXME if get rid of attic/ this can be removed 17 | major=`ocamlc -version | cut -d. -f 1` 18 | xminor=`ocamlc -version | cut -d. -f 2` 19 | if [ $major -ge 4 ] && [ $xminor -le 01 ]; then minor=01; else minor=$xminor; fi 20 | 21 | build_srcs () 22 | { 23 | SDIR=$1 24 | SRCS=`ocamldep -sort $SDIR/*` 25 | for SRC in $SRCS; do 26 | UNIT=`basename $SRC | cut -d. -f1` 27 | OPTS="-bin-annot" 28 | case $UNIT in 29 | "asd_ocaml_incl") # FIXME if get rid of attic/ can be removed 30 | SRC=$SDIR/$major$minor/$u; 31 | UPKGS="$PKGS,compiler-libs.bytecomp";; 32 | "assemblage_driver") 33 | UPKGS="$PKGS,compiler-libs.bytecomp";; 34 | *) 35 | UPKGS="$PKGS";; 36 | esac 37 | 38 | case $SRC in 39 | *.mli) 40 | CMI="$BDIR/$UNIT.cmi" 41 | $OCAMLFIND ocamlc -g -c -I $BDIR $UPKGS $OPTS -o $CMI $SRC ;; 42 | *.ml) 43 | CMO="$BDIR/$UNIT.cmo" 44 | $OCAMLFIND ocamlc -g -c -I $BDIR $UPKGS $OPTS -o $CMO $SRC 45 | CMOS="$CMOS $CMO" ;; 46 | esac 47 | done 48 | } 49 | 50 | # Build everything in $BDIR 51 | build_srcs "lib" 52 | build_srcs "lib-driver" 53 | build_srcs "driver" 54 | 55 | # Build the assemblage command line tool 56 | UPKGS="$PKGS,compiler-libs.toplevel" 57 | OPTS="-bin-annot" 58 | $OCAMLFIND ocamlc $OPTS $UPKGS -I $BDIR -g -linkpkg $CMOS \ 59 | -o $BDIR/assemblage.boot 60 | 61 | # Run it on assemblage's assemblage.ml 62 | $BDIR/assemblage.boot setup --auto-lib=false -I $BDIR --merlin=false 63 | -------------------------------------------------------------------------------- /doc/bootstrap.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | # usage: ./bootstrap.sh [-b] 4 | 5 | set -e 6 | 7 | OCAMLFIND=${OCAMLFIND:="ocamlfind"} 8 | PKGS="-package astring,rresult,fmt,bos,cmdliner,compiler-libs.bytecomp" 9 | 10 | BDIR=_build/bootstrap-doc 11 | 12 | # Make sure $BDIR is clean 13 | rm -rf $BDIR 14 | mkdir -p $BDIR 15 | 16 | # Gather .mli and compile their cmis. 17 | for f in `ls lib/*.mli lib-driver/*.mli driver/*.mli`; do 18 | ln -s "../../$f" $BDIR/`basename $f` 19 | done 20 | 21 | MLIS=`ocamldep -sort $BDIR/*.mli` 22 | 23 | for f in $MLIS; do 24 | $OCAMLFIND ocamlc $PKGS -I $BDIR $f 25 | done 26 | 27 | # Generate doc 28 | MLIS=`ls $BDIR/*.mli | sort -f` 29 | $OCAMLFIND ocamldoc $PKGS -I $BDIR -d $BDIR -html -colorize-code \ 30 | -charset utf-8 $MLIS 31 | cp doc/style.css $BDIR 32 | 33 | if [ "$1" = "-b" ]; then 34 | reload-browser file://$PWD/$BDIR/ 35 | fi 36 | -------------------------------------------------------------------------------- /doc/style.css: -------------------------------------------------------------------------------- 1 | /* A style for ocamldoc. Daniel C. Buenzli */ 2 | 3 | /* Reset a few things. */ 4 | html,body,div,span,applet,object,iframe,h1,h2,h3,h4,h5,h6,p,blockquote,pre, 5 | a,abbr,acronym,address,big,cite,code,del,dfn,em,font,img,ins,kbd,q,s,samp, 6 | small,strike,strong,sub,sup,tt,var,b,u,i,center,dl,dt,dd,ol,ul,li,fieldset, 7 | form,label,legend,table,caption,tbody,tfoot,thead,tr,th,td 8 | { margin: 0; padding: 0; border: 0 none; outline: 0; font-size: 100%; 9 | font-weight: inherit; font-style:inherit; font-family:inherit; 10 | line-height: inherit; vertical-align: baseline; text-align:inherit; 11 | color:inherit; background: transparent; } 12 | 13 | table { border-collapse: collapse; border-spacing: 0; } 14 | 15 | /* Basic page layout */ 16 | 17 | body { font: normal 10pt/1.375em helvetica, arial, sans-serif; text-align:left; 18 | margin: 1.375em 10%; min-width: 40ex; max-width: 72ex; 19 | color: black; background: transparent /* url(line-height-22.gif) */; } 20 | 21 | b { font-weight: bold } 22 | em { font-style: italic } 23 | 24 | tt, code, pre { font-family: WorkAroundWebKitAndMozilla, monospace; 25 | font-size: 1em; } 26 | pre code { font-size : inherit; } 27 | .codepre { margin-bottom:1.375em /* after code example we introduce space. */ } 28 | 29 | .superscript,.subscript 30 | { font-size : 0.813em; line-height:0; margin-left:0.4ex;} 31 | .superscript { vertical-align: super; } 32 | .subscript { vertical-align: sub; } 33 | 34 | /* ocamldoc markup workaround hacks */ 35 | 36 | 37 | 38 | hr, hr + br, div + br, center + br, span + br, ul + br, ol + br, pre + br 39 | { display: none } /* annoying */ 40 | 41 | div.info + br { display:block} 42 | 43 | .codepre br + br { display: none } 44 | h1 + pre { margin-bottom:1.375em} /* Toplevel module description */ 45 | 46 | /* Sections and document divisions */ 47 | 48 | /* .navbar { margin-bottom: -1.375em } */ 49 | h1 { font-weight: bold; font-size: 1.5em; /* margin-top:1.833em; */ 50 | margin-top:0.917em; padding-top:0.875em; 51 | border-top-style:solid; border-width:1px; border-color:#AAA; } 52 | h2 { font-weight: bold; font-size: 1.313em; margin-top: 1.048em } 53 | h3 { font-weight: bold; font-size: 1.125em; margin-top: 1.222em } 54 | h3 { font-weight: bold; font-size: 1em; margin-top: 1.375em} 55 | h4 { font-style: italic; } 56 | 57 | /* Used by OCaml's own library documentation. */ 58 | h6 { font-weight: bold; font-size: 1.125em; margin-top: 1.222em } 59 | .h7 { font-weight: bold; font-size: 1em; margin-top: 1.375em } 60 | 61 | p { margin-top: 1.375em } 62 | pre { margin-top: 1.375em } 63 | .info { margin: 0.458em 0em -0.458em 2em;}/* Description of types values etc. */ 64 | td .info { margin:0; padding:0; margin-left: 2em;} /* Description in indexes */ 65 | 66 | ul, ol { margin-top:0.688em; padding-bottom:0.687em; 67 | list-style-position:outside} 68 | ul + p, ol + p { margin-top: 0em } 69 | ul { list-style-type: square } 70 | 71 | 72 | /* h2 + ul, h3 + ul, p + ul { } */ 73 | ul > li { margin-left: 1.375em; } 74 | ol > li { margin-left: 1.7em; } 75 | /* Links */ 76 | 77 | a, a:link, a:visited, a:active, a:hover { color : #00B; text-decoration: none } 78 | a:hover { text-decoration : underline } 79 | *:target {background-color: #FFFF99;} /* anchor highlight */ 80 | 81 | /* Code */ 82 | 83 | .keyword { font-weight: bold; } 84 | .comment { color : red } 85 | .constructor { color : green } 86 | .string { color : brown } 87 | .warning { color : red ; font-weight : bold } 88 | 89 | /* Functors */ 90 | 91 | .paramstable { border-style : hidden ; padding-bottom:1.375em} 92 | .paramstable code { margin-left: 1ex; margin-right: 1ex } 93 | .sig_block {margin-left: 1em} 94 | 95 | /* Images */ 96 | 97 | img { margin-top: 1.375em } 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | 110 | -------------------------------------------------------------------------------- /driver/builder_makefile.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | (** Default driver makefile generation. *) 19 | 20 | open Assemblage 21 | 22 | val of_project : setup_files:Path.t list -> Assemblage.project -> Makefile.t 23 | -------------------------------------------------------------------------------- /driver/cmd_base.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | open Assemblage 19 | open Assemblage.Private 20 | open Assemblage_driver 21 | open Cmdliner 22 | 23 | let err_multi_project ~using = 24 | strf "Unsupported: multiple projects assembled in the loaded files. \ 25 | Using the project named `%s' and ignoring the others." 26 | (Project.name using) 27 | 28 | let err_no_project files = 29 | "No project assembled in any of the loaded files. Did you call \ 30 | Assemblage.assemble with your project value ?" 31 | 32 | let common_option_section = "COMMON OPTIONS" 33 | 34 | let help_sections = 35 | [ `S common_option_section; 36 | `P "These options are common to all commands."; 37 | `S "ENVIRONMENT"; 38 | `P "$(mname) commands make use of the following environment variables:"; 39 | ] @ Driver.man_vars () @ 40 | [ `S "BUGS"; 41 | `P "Check bug reports at https://github.com/samoht/assemblage/issues."; 42 | `S "AUTHORS"; 43 | `P "Thomas Gazagnaire "; `Noblank; 44 | `P "Daniel C. Buenzli "; ] 45 | 46 | let see_also_section cmds = 47 | if cmds = [] then [] else 48 | let see_also = List.map (strf "$(b,$(mname)-%s)(1)") cmds in 49 | let see_also = String.concat ~sep:", " ("$(b,$(mname))(1)" :: see_also) in 50 | [ `S "SEE ALSO"; `P see_also ] 51 | 52 | let default_cmd init = 53 | let doc = "assemble software projects" in 54 | let man = 55 | [ `S "DESCRIPTION"; 56 | `P "Assemblage provides an OCaml API and a command line tool \ 57 | to setup, build and manage software projects."; 58 | `P "Use '$(mname) help $(i,COMMAND)' for information about \ 59 | $(i,COMMAND)."; 60 | ] @ help_sections 61 | in 62 | let exec_name = Filename.basename Sys.argv.(0) in 63 | let no_cmd_err _ = `Error (true, "No command specified.") in 64 | Term.(ret (pure no_cmd_err $ init)), 65 | Term.info exec_name ~version:"%%VERSION%%" ~sdocs:common_option_section 66 | ~doc ~man 67 | 68 | type 'a cmd = 69 | [ `With_project of 70 | unit Term.t -> Project.t option -> Conf.t Term.t -> Manpage.block list -> 71 | 'a Term.t * Term.info 72 | | `With_project_no_config of 73 | unit Term.t -> Project.t option -> 'a Term.t * Term.info 74 | | `No_project of unit Term.t -> 'a Term.t * Term.info ] 75 | 76 | let cmd name cmd ~doc ~man ~see_also = 77 | let man = man @ help_sections @ see_also_section see_also in 78 | let wrap init cmd = cmd in 79 | `No_project begin fun init -> 80 | Term.(ret (pure wrap $ init $ cmd)), 81 | Term.info name ~doc ~sdocs:common_option_section ~man 82 | end 83 | 84 | let cmd_with_project ?(config = true) name cmd ~doc ~man ~see_also : 'a cmd = 85 | let wrap init p conf cmd = 86 | let p = match p with None -> assert false | Some p -> p in 87 | cmd (Project.with_conf p conf) 88 | in 89 | let wrap_no_config init p cmd = 90 | let p = match p with None -> assert false | Some p -> p in 91 | cmd p 92 | in 93 | if config then 94 | `With_project begin fun init p conf_opts conf_man -> 95 | let man = man @ conf_man @ help_sections @ see_also_section see_also in 96 | Term.(ret (pure wrap $ init $ pure p $ conf_opts $ cmd)), 97 | Term.info name ~doc ~sdocs:common_option_section ~man 98 | end 99 | else 100 | `With_project_no_config begin fun init p -> 101 | let man = man @ help_sections @ see_also_section see_also in 102 | Term.(ret (pure wrap_no_config $ init $ pure p $ cmd)), 103 | Term.info name ~doc ~sdocs:common_option_section ~man 104 | end 105 | 106 | let project_conf p = 107 | (* Project base configuration, overriden by configuration scheme, 108 | overriden by command line options. The driver also uses keys 109 | that may not be used by the project's actions we also add them 110 | to the mix. *) 111 | let driver_keys = 112 | Conf.Key.(Set.singleton (hide_type Conf.mkdir) 113 | |> Set.add (hide_type Conf.build_dir)) 114 | in 115 | let base_keys = match p with 116 | | None -> driver_keys 117 | | Some p -> Conf.Key.Set.union (Project.deps p) driver_keys 118 | in 119 | let base = Conf.of_keys base_keys in 120 | let schemes = match p with None -> [] | Some p -> Project.schemes p in 121 | let scheme = Conf_spec.scheme_ui schemes in 122 | let opts = Conf_spec.ui base in 123 | let merge base scheme opts = match scheme with 124 | | None -> Conf.merge base opts 125 | | Some (_, (_, scheme)) -> Conf.merge (Conf.merge base scheme) opts 126 | in 127 | let conf = Term.(pure merge $ pure base $ scheme $ opts) in 128 | let man = Conf_spec.(scheme_man schemes @ man base) in 129 | conf, man 130 | 131 | let cmds_terms init p cmds = 132 | let conf, conf_man = project_conf p in (* Do it only once *) 133 | let add_cmd = function 134 | | `With_project cmd -> cmd init p conf conf_man 135 | | `With_project_no_config cmd -> cmd init p 136 | | `No_project cmd -> cmd init 137 | in 138 | default_cmd init :: List.map add_cmd cmds 139 | 140 | let terms cmds = 141 | let init, t = Driver.init ~version_opt:true ~docs:common_option_section () in 142 | match init with 143 | | None -> cmds_terms t None cmds 144 | | Some (_, l) -> 145 | let err msg = Term.(ret (pure (fun () -> `Error (false, msg)) $ t)) in 146 | match Project.list () with 147 | | [] -> cmds_terms (err (err_no_project l.Loader.files)) None cmds 148 | | [p] -> cmds_terms t (Some p) cmds 149 | | ps -> 150 | let p = List.hd ps in 151 | Log.warn "%a" Fmt.text (err_multi_project ~using:p); 152 | cmds_terms t (Some p) cmds 153 | -------------------------------------------------------------------------------- /driver/cmd_base.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | (** Base functions for assemblage's cli. *) 19 | 20 | open Cmdliner 21 | open Assemblage 22 | open Assemblage.Private 23 | 24 | type 'a cmd 25 | 26 | val cmd : string -> 'a Term.ret Term.t -> doc:string -> 27 | man:Manpage.block list -> see_also:string list -> 'a cmd 28 | 29 | val cmd_with_project : ?config:bool -> string -> 30 | (Project.t -> 'a Term.ret) Term.t -> doc:string -> 31 | man:Manpage.block list -> see_also:string list -> 'a cmd 32 | 33 | val terms : unit cmd list -> (unit Term.t * Term.info) list 34 | -------------------------------------------------------------------------------- /driver/cmd_build.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | let has_config () = true 19 | let main () = () 20 | (* 21 | (* We could execv to native here *) 22 | if not has_config () then Driver_cli.non_main () else 23 | match Term.eval_choice build_cmd [build_cmd] with 24 | | `Ok () | `Version | `Help -> exit 0 25 | | `Error _ -> exit 1 26 | *) 27 | -------------------------------------------------------------------------------- /driver/cmd_build.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | val main : unit -> unit 19 | -------------------------------------------------------------------------------- /driver/cmd_describe.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | open Assemblage 19 | open Assemblage.Private 20 | 21 | let str = Printf.sprintf 22 | 23 | let describe p = 24 | Log.show "%a" Project.pp_signature p; 25 | Log.show "%a" Conf.pp (Project.conf p); 26 | `Ok () 27 | 28 | (* 29 | let version = "FIXME" in 30 | let open Printf in 31 | let print_deps x = (* TODO *) () 32 | let bold_name pkg = As_shell.color `Bold (As_part.name pkg) in 33 | let pkgs = As_part.(keep_kind `Pkg x) in 34 | match String.concat " " (List.map bold_name pkgs) with 35 | | "" -> "" 36 | | pkgs -> sprintf " ├─── [%s]\n" pkgs 37 | in 38 | let print_modules last modules = 39 | let aux i n m = 40 | printf " %s %s\n" 41 | (if last && i = n then "└───" else "├───") (As_shell.color `Blue m) in 42 | let n = List.length modules - 1 in 43 | List.iteri (fun i m -> aux i n m) modules in 44 | let print_units units = 45 | let aux i n u = 46 | let mk f ext = 47 | if not (f u) then "" else 48 | As_shell.color `Cyan (As_part.name u ^ ext) 49 | in 50 | let ml = mk As_component.Unit.(has `Ml) ".ml" in 51 | let mli = mk As_component.Unit.(has `Mli) ".mli" in 52 | let modules = 53 | if As_component.Unit.generated u then ["--generated--"] 54 | else 55 | let build_dir = As_build_env.build_dir build_env in 56 | As_OCaml.modules ~build_dir u in 57 | printf " %s %-25s%-25s\n" 58 | (if modules = [] && i = n then "└─" else "├─") ml mli; 59 | print_modules (i=n) modules 60 | in 61 | let n = List.length units - 1 in 62 | List.iteri (fun i u -> aux i n u) units in 63 | in 64 | let print cs = () 65 | (* TODO *) 66 | 67 | let aux c = 68 | let open As_component in 69 | printf "└─┬─ %s\n%s" 70 | (As_shell.color `Magenta (id c)) (print_deps (deps c)); 71 | print_units (filter_map unit (contents c)) in 72 | List.iter aux cs in 73 | 74 | in 75 | let parts = Part.keep_kinds [`Lib; `Bin] (Project.parts p) in 76 | log_project env version p; 77 | print parts; 78 | *) 79 | 80 | 81 | (* Command line interface *) 82 | 83 | open Cmdliner 84 | 85 | let cmd = 86 | let doc = "describe an OCaml project" in 87 | let man = 88 | [ `S "DESCRIPTION"; 89 | `P "The $(b,describe) command outputs various descriptions of a 90 | configured project." ] 91 | in 92 | let describe = Term.(pure describe) in 93 | Cmd_base.cmd_with_project "describe" describe ~doc ~man ~see_also:["setup"] 94 | -------------------------------------------------------------------------------- /driver/cmd_describe.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | (** Assemblage's describe command. *) 19 | 20 | open Assemblage 21 | open Assemblage.Private 22 | 23 | val cmd : unit Cmd_base.cmd 24 | -------------------------------------------------------------------------------- /driver/cmd_help.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | let help man_format cmds topic = match topic with 19 | | None -> `Help (`Pager, None) (* help about the program. *) 20 | | Some topic -> 21 | let topics = "topics" :: cmds in 22 | let conv, _ = Cmdliner.Arg.enum (List.rev_map (fun s -> (s, s)) topics) in 23 | match conv topic with 24 | | `Error e -> `Error (false, e) 25 | | `Ok t when t = "topics" -> List.iter print_endline topics; `Ok () 26 | | `Ok t when List.mem t cmds -> `Help (man_format, Some t) 27 | | `Ok _ -> assert false 28 | 29 | (* Command line interface *) 30 | 31 | open Cmdliner 32 | 33 | let cmd = 34 | let topic = 35 | let doc = "The topic to get help on. `topics' lists the topics." in 36 | Arg.(value & pos 0 (some string) None & info [] ~docv:"TOPIC" ~doc) 37 | in 38 | let doc = "display help about assemblage and assemblage commands" in 39 | let man = 40 | [ `S "DESCRIPTION"; 41 | `P "Prints help about assemblage commands and other subjects..."] 42 | in 43 | let help = Term.(pure help $ Term.man_format $ Term.choice_names $ topic) in 44 | Cmd_base.cmd "help" help ~doc ~man ~see_also:[] 45 | -------------------------------------------------------------------------------- /driver/cmd_help.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | (** Assemblage's help command. *) 19 | 20 | val cmd : unit Cmd_base.cmd 21 | -------------------------------------------------------------------------------- /driver/cmd_product.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Daniel C. Bünzli 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | open Assemblage 18 | open Assemblage.Private 19 | 20 | let str = Printf.sprintf 21 | 22 | (* FIXME this is a proof of concept. Things that 23 | should be improved: basic globbing for product selection 24 | Highlighting using pp_style, better formatting (don't 25 | use the library's pp). Well thought command line UI. etc. *) 26 | 27 | type index = 28 | { inputs : (part_kind Part.t * Action.t) list Path.Map.t; 29 | outputs : (part_kind Part.t * Action.t) list Path.Map.t; } 30 | 31 | let index proj = 32 | let add_index part act acc p = match Path.Map.find p acc with 33 | | None -> Path.Map.add p [part, act] acc 34 | | Some occs -> Path.Map.add p ((part, act) :: occs) acc 35 | in 36 | let add_part acc part = 37 | let add_action (i, o) act = 38 | List.fold_left (add_index part act) i (Action.inputs act), 39 | List.fold_left (add_index part act) o (Action.outputs act) 40 | in 41 | List.fold_left add_action acc (Project.eval proj (Part.actions part)) 42 | in 43 | let init = Path.Map.empty, Path.Map.empty in 44 | let inputs, outputs = Part.list_fold add_part init (Project.parts proj) in 45 | {inputs; outputs} 46 | 47 | let find_refs index kind selection = 48 | let merge _ i o = match i, o with 49 | | None, Some l | Some l, None -> Some l 50 | | Some i, Some o -> Some (List.rev_append (List.rev i) o) 51 | | None, None -> assert false 52 | in 53 | let inputs = Path.Map.dom index.inputs in 54 | let outputs = Path.Map.dom index.outputs in 55 | let sel = match selection with 56 | | [] -> Path.Set.union inputs outputs 57 | | l -> Path.Set.of_list (List.rev_map Path.v (* TODO FIXME *) selection) 58 | in 59 | let sel = match kind with 60 | | `Any -> sel 61 | | `Source -> Path.Set.inter sel (Path.Set.diff inputs outputs) 62 | | `Input -> Path.Set.inter sel inputs 63 | | `Output -> Path.Set.inter sel outputs 64 | in 65 | let mi = Path.Map.filter (fun k _ -> Path.Set.mem k sel) index.inputs in 66 | let mo = Path.Map.filter (fun k _ -> Path.Set.mem k sel) index.outputs in 67 | Path.Map.merge merge mi mo 68 | 69 | let refs proj kind selection details = 70 | let index = index proj in 71 | let refs = Path.Map.bindings (find_refs index kind selection) in 72 | let pp_ref key ppf (part, act) = 73 | Fmt.pf ppf "%s %a - %s" 74 | (Part.name part) Part.pp_kind (Part.kind part) (Path.to_string key) 75 | in 76 | let pp_ref_details key ppf (part, act) = 77 | Fmt.pf ppf "@[%s@, part: @[%a %s@]@, @[%a@]@]@," 78 | (Path.to_string key) Part.pp_kind (Part.kind part) 79 | (Part.name part) (Action.pp (Project.conf proj)) act 80 | in 81 | let pp_ref = if details then pp_ref_details else pp_ref in 82 | let pp_refs ppf (k, refs) = Fmt.pf ppf "%a" (Fmt.list (pp_ref k)) refs in 83 | Fmt.pr "@[%a@]@." (Fmt.list pp_refs) refs; 84 | `Ok () 85 | 86 | let list proj kind = 87 | let products = Path.Set.elements (Project.products ~kind proj) in 88 | let pp_product ppf p = Path.pp ppf p in 89 | Fmt.pr "@[%a@]@." (Fmt.list pp_product) products; 90 | `Ok () 91 | 92 | let product cmd kind selection details p = match cmd with 93 | | `List -> list p kind 94 | | `Refs -> refs p kind selection details 95 | 96 | (* Command line interface *) 97 | 98 | open Cmdliner 99 | 100 | let kind = 101 | let doc = "Select only source products." in 102 | let src = Arg.info ~doc ["source"] in 103 | let doc = "Select only build products." in 104 | let build = Arg.info ~doc ["build"] in 105 | let doc = "Select only input products." in 106 | let input = Arg.info ~doc ["input"] in 107 | Arg.(value & vflag `Any [`Source, src; `Output, build; `Input, input ]) 108 | 109 | let subcmd = 110 | let conv_sub = Arg.enum ["list", `List; "references", `Refs] in 111 | let doc = "The command to apply on products." in 112 | Arg.(value & pos 0 conv_sub `List & info [] ~doc ~docv:"COMMAND") 113 | 114 | let selection = 115 | let doc = "The products to select." in 116 | Arg.(value & pos_right 0 string [] & info [] ~doc ~docv:"PRODUCT") 117 | 118 | let details = 119 | let doc = "Show reference details" in 120 | Arg.(value & flag & info ["d"; "details"] ~doc) 121 | 122 | let cmd = 123 | let doc = "information about project products" in 124 | let man = 125 | [ `S "DESCRIPTION"; 126 | `P "The $(b,product) command outputs information about products 127 | known to assemblage in a given configuration." ] 128 | in 129 | let product = Term.(pure product $ subcmd $ kind $ selection $ details) in 130 | Cmd_base.cmd_with_project "product" product ~doc ~man ~see_also:["setup"] 131 | -------------------------------------------------------------------------------- /driver/cmd_product.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | (** Assemblage's products command. *) 19 | 20 | open Assemblage 21 | open Assemblage.Private 22 | 23 | val cmd : unit Cmd_base.cmd 24 | -------------------------------------------------------------------------------- /driver/cmd_setup.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | open Assemblage 19 | open Assemblage.Private 20 | open Assemblage_tools 21 | 22 | let str = Printf.sprintf 23 | 24 | let write file s = 25 | let pp_arrow = Fmt.(styled `Green @@ verbatim "==>") in 26 | Log.show "%a write %s" pp_arrow () (Path.to_string file); 27 | Log.on_error_msg ~use:() @@ 28 | OS.File.write file s; 29 | () 30 | 31 | let write_meta p file = write file Meta.(to_string @@ of_project p) 32 | let write_merlin p file = write file Merlin.(to_string @@ of_project p) 33 | let write_install p meta file = 34 | let add = [ `Lib (Opam.Install.move meta) ] in 35 | write file Opam.Install.(to_string @@ of_project ~add p) 36 | 37 | let write_makefile p ~setup_files file = 38 | let mk = Builder_makefile.of_project ~setup_files p in 39 | write file (Makefile.to_string mk) 40 | 41 | let setup `Make ~merlin p = 42 | let add_if c v acc = if c then v :: acc else acc in 43 | let install = Path.v (str "%s.install" @@ Project.name p) in 44 | let dotmerlin = Path.v ".merlin" in 45 | let makefile = Path.v "Makefile" in 46 | let meta = Path.(Project.eval_key p Conf.build_dir / "META") in 47 | let setup_files = 48 | add_if merlin dotmerlin @@ install :: meta :: makefile :: [] 49 | in 50 | Log.show "%a@." Project.pp_signature p; 51 | write_meta p meta; 52 | write_install p meta install; 53 | write_makefile p ~setup_files makefile; 54 | if merlin then write_merlin p dotmerlin; 55 | `Ok () 56 | 57 | (* Command line interface *) 58 | 59 | open Cmdliner 60 | 61 | let cmd = 62 | let doc = "setup an assemblage project" in 63 | let man = 64 | [ `S "DESCRIPTION"; 65 | `P "The $(b,setup) command generates a build system to build the 66 | parts defined in an assemble.ml file. An initial configuration 67 | for the build system can be specified on the command line by 68 | specifying configuration keys using the flags described below."; ] 69 | in 70 | let see_also = ["build"; "describe"] in 71 | let merlin_opt = 72 | let doc = "Generate a .merlin file." in 73 | Arg.(value & opt bool true & info ["merlin"] ~doc ~docv:"BOOL") 74 | in 75 | let setup make merlin = setup make ~merlin in 76 | let setup = Term.(pure setup $ pure `Make $ merlin_opt) in 77 | Cmd_base.cmd_with_project "setup" setup ~doc ~man ~see_also 78 | -------------------------------------------------------------------------------- /driver/cmd_setup.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | (** Assemblage's setup command. *) 19 | 20 | val cmd : unit Cmd_base.cmd 21 | -------------------------------------------------------------------------------- /driver/main.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | (* The assemblage command line tool. *) 19 | 20 | open Cmdliner 21 | open Assemblage 22 | open Assemblage.Private 23 | 24 | let main () = 25 | let cmd = if Array.length Sys.argv < 2 then None else Some Sys.argv.(1) in 26 | match cmd with 27 | | Some ("b" | "bu" | "bui" | "buil" | "build") -> Cmd_build.main () 28 | | _ -> 29 | let cmds = [ Cmd_setup.cmd; Cmd_describe.cmd; Cmd_product.cmd ] in 30 | let cmds = Cmd_base.terms cmds in 31 | match Term.eval_choice (List.hd cmds) (List.tl cmds) with 32 | | `Error _ -> exit 1 33 | | `Ok () | `Version | `Help -> 34 | if Log.err_count () <> 0 then exit 1 else exit 0 35 | 36 | let () = main () 37 | -------------------------------------------------------------------------------- /driver/makefile.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | open Astring 19 | 20 | (* Variables *) 21 | 22 | type var = 23 | { name : string; 24 | op : string; 25 | def : string list; } 26 | 27 | let ( === ) name def = `Var { name; op = "="; def } 28 | let ( =:= ) name def = `Var { name; op = ":="; def } 29 | let ( =::= ) name def = `Var { name; op = "::="; def } 30 | let ( =+= ) name def = `Var { name; op = "+="; def } 31 | let ( =?= ) name def = `Var { name; op = "?="; def } 32 | 33 | module Infix = struct 34 | let ( === ) = ( === ) 35 | let ( =:= ) = ( =:= ) 36 | let ( =::= ) = ( =::= ) 37 | let ( =+= ) = ( =+= ) 38 | let ( =?= ) = ( =?= ) 39 | end 40 | 41 | (* Rules *) 42 | 43 | type rule = 44 | { ext : bool; 45 | targets : string list; 46 | prereqs : string list; 47 | order_only_prereqs : string list; 48 | recipe : string list list; } 49 | 50 | let rule ?(ext = false) ?(order_only_prereqs = []) ~targets ~prereqs ~recipe 51 | () = 52 | `Rule { ext; targets; prereqs; order_only_prereqs; recipe; } 53 | 54 | (* Makefiles *) 55 | 56 | type statement = 57 | [ `Var of var 58 | | `Rule of rule 59 | | `Include of string ] 60 | 61 | type t = [ statement | `Comment of string | `Blank ] list 62 | 63 | let buf_add_strings ?(max = 76) ?(nl = "\\\n") ?(indent = " ") b count ss = 64 | let indent_len = String.length indent in 65 | let rec loop first count = function 66 | | [] -> () 67 | | d :: ds as defs -> 68 | let new_len = String.length d + count + 1 in 69 | if new_len > max && count > indent_len && not first 70 | then begin 71 | Buffer.add_string b (strf "%s%s" nl indent); loop false indent_len defs 72 | end else begin 73 | Buffer.add_string b d; 74 | if ds <> [] then (Buffer.add_char b ' '; loop false new_len ds) 75 | end 76 | in 77 | loop true count ss 78 | 79 | let buf_add_var b { name; op; def } = 80 | Buffer.add_string b name; 81 | Buffer.add_char b ' '; 82 | Buffer.add_string b op; 83 | Buffer.add_char b ' '; 84 | buf_add_strings b String.(length name + length op + 2) def; 85 | Buffer.add_char b '\n'; 86 | () 87 | 88 | let buf_add_cmd b cmd = 89 | Buffer.add_string b "\t"; 90 | buf_add_strings ~indent:"\t " b 4 cmd; 91 | Buffer.add_char b '\n'; 92 | () 93 | 94 | let buf_add_rule b { ext; targets; prereqs; order_only_prereqs; recipe } = 95 | let has_oo = order_only_prereqs <> [] in 96 | let oo = if has_oo then "|" :: order_only_prereqs else [] in 97 | let reqs = prereqs @ oo in 98 | buf_add_strings ~indent:"" b 0 targets; 99 | Buffer.add_string b (if ext then "::" else ":"); 100 | if reqs <> [] then begin 101 | Buffer.add_string b " \\\n "; 102 | buf_add_strings b 4 (prereqs @ oo); 103 | end; 104 | Buffer.add_char b '\n'; 105 | List.iter (buf_add_cmd b) recipe; 106 | Buffer.add_char b '\n'; 107 | () 108 | 109 | let buf_add_comment b c = 110 | let indent = "# " in 111 | Buffer.add_string b indent; 112 | buf_add_strings ~nl:"\n" ~indent b 2 (String.cuts ~sep:" " c); 113 | Buffer.add_char b '\n'; 114 | () 115 | 116 | let buf_add_include b f = 117 | Buffer.add_string b "-include "; (* FIXME: add an option for - ? *) 118 | Buffer.add_string b f; 119 | Buffer.add_char b '\n'; 120 | () 121 | 122 | let to_string mk = 123 | let b = Buffer.create 8192 in 124 | let add = function 125 | | `Blank -> Buffer.add_char b '\n' 126 | | `Var v -> buf_add_var b v 127 | | `Rule r -> buf_add_rule b r 128 | | `Comment c -> buf_add_comment b c 129 | | `Include f -> buf_add_include b f 130 | in 131 | List.iter add mk; 132 | Buffer.contents b 133 | -------------------------------------------------------------------------------- /driver/makefile.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | (** Makefiles. 19 | 20 | Functions to specify and generate 21 | {{:http://www.gnu.org/software/make/manual/make.html}Makefiles}. *) 22 | 23 | (** {1 Makefile variables} *) 24 | 25 | type var 26 | (** The type for makefile variable declarations. *) 27 | 28 | (** {b Note.} In the following functions. The right hand-side of 29 | variables is a list of strings. On output these strings are 30 | separated by one space and can be used as a break point if the 31 | line becomes too long. *) 32 | 33 | val ( === ) : string -> string list -> [> `Var of var ] 34 | (** [v === def] is [v = def]. *) 35 | 36 | val ( =:= ) : string -> string list -> [> `Var of var ] 37 | (** [v =:= def] is [v := def]. *) 38 | 39 | val ( =::= ) : string -> string list -> [> `Var of var ] 40 | (** [v =::= def] is [v ::= def]. *) 41 | 42 | val ( =+= ) : string -> string list -> [> `Var of var ] 43 | (** [v =+= def] is [v += def]. *) 44 | 45 | val ( =?= ) : string -> string list -> [> `Var of var ] 46 | (** [v =+= def] is [v += def]. *) 47 | 48 | (** Infix operators. *) 49 | module Infix : sig 50 | val ( === ) : string -> string list -> [> `Var of var ] 51 | (** [( === )] is {!( === )}. *) 52 | val ( =:= ) : string -> string list -> [>`Var of var ] 53 | (** [( =:= )] is {!( =:= )}. *) 54 | val ( =::= ) : string -> string list -> [> `Var of var ] 55 | (** [( =::= )] is {!( =::= )}. *) 56 | val ( =+= ) : string -> string list -> [> `Var of var ] 57 | (** [( =+= )] is {!( =+= )}. *) 58 | val ( =?= ) : string -> string list -> [> `Var of var ] 59 | (** [( =?= )] is {!( =?= )}. *) 60 | end 61 | 62 | (** {1:rules Rules} *) 63 | 64 | type rule 65 | (** The type for makefile rules. *) 66 | 67 | val rule : ?ext:bool -> ?order_only_prereqs:string list -> 68 | targets:string list -> prereqs:string list -> recipe:string list list -> 69 | unit -> [> `Rule of rule ] 70 | (** [rule ext order_only_prereqs targets prerequs recipe ()] is a makefile 71 | rule. [ext] indicates whether the rule should be extensible (double colon 72 | rule, defaults to [false]). 73 | 74 | [recipe] is a list of commands. Commands are list of strings. 75 | On output the later strings are separated by one space and can be used 76 | as a break point if the line becomes too long. *) 77 | 78 | (** {1:makefile Makefiles} *) 79 | 80 | type statement = 81 | [ `Var of var 82 | | `Rule of rule 83 | | `Include of string ] 84 | (** The type for makefile statements. *) 85 | 86 | type t = [ statement | `Comment of string | `Blank ] list 87 | (** The type for makefiles. *) 88 | 89 | val to_string : t -> string 90 | (** [to_string m] is [m] as a string. *) 91 | -------------------------------------------------------------------------------- /examples/camlp4/assemble.ml: -------------------------------------------------------------------------------- 1 | open Assemblage 2 | 3 | let t = unit "t" ~needs:[ 4 | pkg "sexplib.syntax"; 5 | pkg "comparelib.syntax"; 6 | pkg "sexplib"; 7 | pkg "comparelib"; 8 | pkg "xmlm"; ] 9 | 10 | let lib = lib "mylib" [t] 11 | let () = assemble (Project.v "camlp4o" [lib]) 12 | -------------------------------------------------------------------------------- /examples/camlp4/t.ml: -------------------------------------------------------------------------------- 1 | open Sexplib.Std 2 | 3 | type t = { 4 | foo: int; 5 | } with sexp, compare 6 | 7 | type y = 8 | | Foo: int -> y 9 | with sexp 10 | 11 | let x = Xmlm.input 12 | -------------------------------------------------------------------------------- /examples/containers/a.ml: -------------------------------------------------------------------------------- 1 | Printf.printf "Hello (A)!\n" 2 | -------------------------------------------------------------------------------- /examples/containers/assemble.ml: -------------------------------------------------------------------------------- 1 | open Assemblage 2 | 3 | let a = unit "a" 4 | let b = unit "b" 5 | 6 | let b1 = bin "b1" [b; a] 7 | let b2 = bin "b2" [b] 8 | let l = lib "l" [a] 9 | let b3 = bin "b3" [b; l] ~args:Args.linkall 10 | 11 | let () = assemble (Project.v "containers" [b1; b2; b3]) 12 | -------------------------------------------------------------------------------- /examples/containers/b.ml: -------------------------------------------------------------------------------- 1 | Printf.printf "Hello (B)!\n" 2 | -------------------------------------------------------------------------------- /examples/cstubs/assemble.ml: -------------------------------------------------------------------------------- 1 | open Assemblage 2 | 3 | let date = cstubs "date" [] 4 | let date_cmd = 5 | let date_cmd = unit "date_cmd" [date] in 6 | bin "date-cmd" [date_cmd] 7 | 8 | let test = test "test" [] [ test_bin date_cmd () ] 9 | 10 | let () = assemble (project "date" [test]) 11 | -------------------------------------------------------------------------------- /examples/cstubs/date_bindings.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Jeremy Yallop. 3 | * 4 | * This file is distributed under the terms of the MIT License. 5 | * See the file LICENSE for details. 6 | *) 7 | 8 | open Ctypes 9 | open PosixTypes 10 | 11 | type tm 12 | let tm = structure "tm" 13 | let (-:) ty label = field tm label ty 14 | let tm_sec = int -: "tm_sec" (* seconds *) 15 | let tm_min = int -: "tm_min" (* minutes *) 16 | let tm_hour = int -: "tm_hour" (* hours *) 17 | let tm_mday = int -: "tm_mday" (* day of the month *) 18 | let tm_mon = int -: "tm_mon" (* month *) 19 | let tm_year = int -: "tm_year" (* year *) 20 | let tm_wday = int -: "tm_wday" (* day of the week *) 21 | let tm_yday = int -: "tm_yday" (* day in the year *) 22 | let tm_isdst = int -: "tm_isdst" (* daylight saving time *) 23 | let () = seal (tm : tm structure typ) 24 | 25 | module Make 26 | (F : sig type _ fn 27 | val foreign : string -> ('a -> 'b) Ctypes.fn -> ('a -> 'b) fn end) = 28 | struct 29 | open F 30 | 31 | let time = foreign "time" (ptr time_t @-> returning time_t) 32 | 33 | let asctime = foreign "asctime" (ptr tm @-> returning string) 34 | 35 | let localtime = foreign "localtime" (ptr time_t @-> returning (ptr tm)) 36 | end 37 | -------------------------------------------------------------------------------- /examples/cstubs/date_cmd.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Jeremy Yallop. 3 | * 4 | * This file is distributed under the terms of the MIT License. 5 | * See the file LICENSE for details. 6 | *) 7 | 8 | open Ctypes 9 | open PosixTypes 10 | open Date 11 | 12 | let () = begin 13 | let timep = allocate_n ~count:1 time_t in 14 | let time = time timep in 15 | assert (time = !@timep); 16 | let tm = localtime timep in 17 | Printf.printf "tm.tm_mon = %d\n" (getf !@tm tm_mon); 18 | Printf.printf "tm.tm_year = %d\n" (getf !@tm tm_year); 19 | print_endline (asctime tm) 20 | end 21 | -------------------------------------------------------------------------------- /examples/ctypes-libffi/assemble.ml: -------------------------------------------------------------------------------- 1 | open Assemblage 2 | 3 | let username = 4 | bin "username" [ unit "main"; pkg "ctypes"; pkg "ctypes.foreign" ] 5 | 6 | let () = assemble (Project.v "username" [username]) 7 | -------------------------------------------------------------------------------- /examples/ctypes-libffi/main.ml: -------------------------------------------------------------------------------- 1 | 2 | open Ctypes 3 | 4 | let getenv = Foreign.foreign "getenv" (string @-> returning string_opt) 5 | 6 | let () = match (getenv "USER") with 7 | | Some u -> print_endline u 8 | | None -> () 9 | -------------------------------------------------------------------------------- /examples/gen-quine/assemble.ml: -------------------------------------------------------------------------------- 1 | open Assemblage 2 | 3 | 4 | let unit ?dir u = unit u ?dir ~kind:(`OCaml (`Ml, `Normal)) 5 | 6 | let repro = bin "repro" [ unit "quine" ] 7 | 8 | (* FIXME it would be better to generate in gen's root dir 9 | but the api is not good yet. Need to specify stdout when 10 | we don't have the part's root yet since it doesn't exist. 11 | We generate in repro's dir instead, but this kind of 12 | thing should not be done. *) 13 | let repro_dir = Part.root_path repro 14 | let repro_unit = "quine_repro" 15 | let repro_src = repro_dir / (repro_unit ^ ".ml") 16 | let gen = Bin.gen repro (Conf.const []) ~stdout:repro_src 17 | 18 | let quine = bin "quine" [ unit ~dir:repro_dir repro_unit ] 19 | 20 | let () = assemble (Project.v "quine" [gen; repro; quine]) 21 | -------------------------------------------------------------------------------- /examples/gen-quine/quine.ml: -------------------------------------------------------------------------------- 1 | (fun p -> Printf.printf p (string_of_format p)) 2 | "(fun p -> Printf.printf p (string_of_format p))\n %S\n" 3 | -------------------------------------------------------------------------------- /examples/hello/assemble.ml: -------------------------------------------------------------------------------- 1 | open Assemblage 2 | 3 | let hello = bin "hello" [ unit "main" ] 4 | let () = assemble (Project.v "hello" [hello]) 5 | -------------------------------------------------------------------------------- /examples/hello/main.ml: -------------------------------------------------------------------------------- 1 | 2 | let () = print_endline "Hello World!" 3 | -------------------------------------------------------------------------------- /examples/multi-libs/a/a.ml: -------------------------------------------------------------------------------- 1 | let x = Ezjsonm.from_string "{}" 2 | 3 | let (l: S.t list ref) = ref [6;7] 4 | -------------------------------------------------------------------------------- /examples/multi-libs/a/a1.ml: -------------------------------------------------------------------------------- 1 | let () = 2 | A.l := [1;2;3] 3 | -------------------------------------------------------------------------------- /examples/multi-libs/a/s.mli: -------------------------------------------------------------------------------- 1 | type t = int 2 | -------------------------------------------------------------------------------- /examples/multi-libs/assemble.ml: -------------------------------------------------------------------------------- 1 | open Assemblage 2 | 3 | let dir_a = root / "a" 4 | let s = unit "s" ~dir:dir_a 5 | let a = lib "lib-a" [s; unit "a" ~dir:dir_a ~needs:[pkg "ezjsonm"]] 6 | let a1 = lib "lib-a-1" [unit "a1" ~dir:dir_a ~needs:[a]] 7 | 8 | let b = 9 | let dir = root / "b" in 10 | let b = unit "b" ~dir ~needs:[a] in 11 | let c = unit "c" ~dir in 12 | lib "lib2" [b; c] 13 | 14 | let bin = 15 | bin "a-test" [unit "foo" ~needs:[a; a1; b]] ~args:Args.linkall 16 | 17 | let () = assemble (Project.v "multi-libs" [a; b; bin]) 18 | -------------------------------------------------------------------------------- /examples/multi-libs/b/b.ml: -------------------------------------------------------------------------------- 1 | let y = A.x 2 | -------------------------------------------------------------------------------- /examples/multi-libs/b/c.ml: -------------------------------------------------------------------------------- 1 | let z = B.y 2 | 3 | let () = 4 | List.iter (Printf.printf "%d %!") !A.l; 5 | print_newline () 6 | -------------------------------------------------------------------------------- /examples/multi-libs/foo.ml: -------------------------------------------------------------------------------- 1 | let () = 2 | print_endline "foo" 3 | -------------------------------------------------------------------------------- /examples/pack/assemble.ml: -------------------------------------------------------------------------------- 1 | open Assemblage 2 | 3 | let dir = root / "src" 4 | 5 | let a = unit "a" ~dir 6 | let b = 7 | let dir = dir / "b" in 8 | (* FIXME *) 9 | pack "b" [ unit "a" ~dir; unit "c" ~dir; ] 10 | 11 | let main = bin "main" [ unit "main" ~dir; a; b ] 12 | 13 | let () = assemble (Project.v "pack" [main]) 14 | -------------------------------------------------------------------------------- /examples/pack/src/a.ml: -------------------------------------------------------------------------------- 1 | let foo = "A.foo" 2 | -------------------------------------------------------------------------------- /examples/pack/src/b/a.ml: -------------------------------------------------------------------------------- 1 | let foo = "B.A.foo" 2 | -------------------------------------------------------------------------------- /examples/pack/src/b/c.ml: -------------------------------------------------------------------------------- 1 | let foo = "B.C.foo" 2 | -------------------------------------------------------------------------------- /examples/pack/src/main.ml: -------------------------------------------------------------------------------- 1 | open Printf 2 | 3 | let () = 4 | printf "A.foo: %s\n" A.foo; 5 | printf "B.A.foo: %s\n" B.A.foo; 6 | printf "B.C.foo: %s\n" B.C.foo; 7 | () 8 | -------------------------------------------------------------------------------- /examples/threads-lib/assemble.ml: -------------------------------------------------------------------------------- 1 | open Assemblage 2 | 3 | let units = [ unit "tlib" ] 4 | let posix = lib "tlib-posix" ~args:Args.thread units 5 | let vm = 6 | lib "tlib-vm" ~native:false ~native_dynlink:false ~args:Args.vmthread units 7 | 8 | let () = assemble (Project.v "threads-lib" [posix; vm]) 9 | -------------------------------------------------------------------------------- /examples/threads-lib/tlib.ml: -------------------------------------------------------------------------------- 1 | 2 | let run f v = ignore (Thread.create f v) 3 | -------------------------------------------------------------------------------- /examples/threads-lib/tlib.mli: -------------------------------------------------------------------------------- 1 | 2 | val run : ('a -> 'b) -> 'a -> unit 3 | -------------------------------------------------------------------------------- /examples/threads/assemble.ml: -------------------------------------------------------------------------------- 1 | open Assemblage 2 | 3 | let pkg_threads_posix = pkg "threads.posix" 4 | let pkg_threads_vm = pkg "threads.vm" 5 | 6 | let main = unit "main" 7 | let posix = bin "hello-pthread" ~args:Args.thread [ pkg_threads_posix; main ] 8 | let vm = 9 | bin "hello-vmthread" ~args:Args.vmthread ~native:false 10 | [ pkg_threads_vm; main ] 11 | 12 | let () = assemble (Project.v "hello-thread" [posix; vm]) 13 | -------------------------------------------------------------------------------- /examples/threads/main.ml: -------------------------------------------------------------------------------- 1 | 2 | let () = Thread.(join (create print_endline "Hello Threaded World!")) 3 | -------------------------------------------------------------------------------- /lib-driver/assemblage_tools.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Daniel C. Bünzli 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | (** Driver project tools. *) 18 | 19 | open Assemblage 20 | open Assemblage.Private 21 | 22 | module Opam = Ast_opam 23 | module Meta = Ast_meta 24 | module Merlin = Ast_merlin 25 | -------------------------------------------------------------------------------- /lib-driver/assemblage_tools.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Daniel C. Bünzli 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | (** Driver project tools. *) 18 | 19 | open Assemblage 20 | open Assemblage.Private 21 | 22 | (** {1 Project tools} *) 23 | 24 | (** OPAM support. 25 | 26 | Synchronize OPAM metadata and generate install files. *) 27 | module Opam : sig 28 | 29 | (** {1 Metadata synchronization} *) 30 | 31 | (** Metadata synchronization. *) 32 | module Sync : sig 33 | end 34 | 35 | (** {1 Install files} *) 36 | 37 | (** Install files. 38 | 39 | Generate OPAM {{:http://opam.ocaml.org/doc/manual/dev-manual.html#sec25} 40 | package installation files}. *) 41 | module Install : sig 42 | 43 | (** {1 Install file} *) 44 | 45 | type move 46 | (** The type for file moves. *) 47 | 48 | val move : ?maybe:bool -> ?dst:Path.t -> Path.t -> move 49 | (** [move src ~dst] moves [src] to [dst]. [src] is expressed 50 | relative to the install file and [dst] relative to the 51 | destination directory which is determined by the move's 52 | {{!field_elt}field}. If [dst] is absent [src] is placed at the root 53 | of the destination directory. [maybe] indicates that [src] 54 | may be absent (defaults to [false]). *) 55 | 56 | type field_elt = 57 | [ `Bin of move | `Doc of move | `Etc of move | `Lib of move | `Man of move 58 | | `Misc of move | `Sbin of move | `Share of move | `Share_root of move 59 | | `Stublibs of move | `Toplevel of move ] 60 | (** The type for field elements. Determines the destination 61 | directory of an {!move}. *) 62 | 63 | type t = [ `Header of string option ] * field_elt list 64 | (** The type for install files. An optional introductory comment followed 65 | by file moves. *) 66 | 67 | val to_string : t -> string 68 | (** [to_string i] is [i] as a string. *) 69 | 70 | val of_project : ?add:field_elt list -> Assemblage.project -> t 71 | (** [of_project add p] is an install file for project [p] and [add]. *) 72 | end 73 | end 74 | 75 | (** Findlib META support. 76 | 77 | Generate findlib 78 | {{:http://projects.camlcity.org/projects/dl/findlib-1.5.5/doc/ref-html/r700.html} 79 | META files}. *) 80 | module Meta : sig 81 | 82 | (** {1 META files} *) 83 | 84 | type t 85 | (** The type for Findlib META files. *) 86 | 87 | val to_string : t -> string 88 | (** [to_string meta] is [m] as a string. *) 89 | 90 | val of_project : Assemblage.project -> t 91 | (** [of_project p] is a META file for project [p]. *) 92 | end 93 | 94 | (** Merlin support. 95 | 96 | Generate {{:https://github.com/the-lambda-church/merlin}Merlin} 97 | {{:https://github.com/the-lambda-church/merlin#merlin-project} 98 | project files}. *) 99 | module Merlin : sig 100 | 101 | (** {1 Merlin project file} *) 102 | 103 | type directive = 104 | [ `REC | `S of string | `B of string | `PKG of string 105 | | `FLG of string list | `EXT of string list ] 106 | (** The type for Merlin directives. *) 107 | 108 | type t = [ `Comment of string | `Blank | directive ] list 109 | (** The type for Merlin project files. *) 110 | 111 | val to_string : t -> string 112 | (** [to_string m] is [m] as a string. *) 113 | 114 | val of_project : project -> t 115 | (** [of_project p] is a merlin file for project [p]. *) 116 | end 117 | -------------------------------------------------------------------------------- /lib-driver/ast_merlin.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 David Sheets 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | open Assemblage 19 | open Assemblage.Private 20 | 21 | 22 | (* Merlin project file *) 23 | 24 | type directive = 25 | [ `REC | `S of string | `B of string | `PKG of string 26 | | `FLG of string list | `EXT of string list ] 27 | 28 | type t = [ `Comment of string | `Blank | directive ] list 29 | 30 | let to_string m = 31 | let b = Buffer.create 1024 in 32 | let pr fmt = Printf.bprintf b fmt in 33 | let add = function 34 | | `Blank -> pr "\n" 35 | | `Comment c -> pr "# %s\n" c 36 | | `S s -> pr "S %s\n" s 37 | | `B bdir -> pr "B %s\n" bdir 38 | | `PKG pkg -> pr "PKG %s\n" pkg 39 | | `FLG flags -> pr "FLG %s\n" (String.concat ~sep:" " flags) 40 | | `EXT exts -> pr "EXT %s\n" (String.concat ~sep:" " exts) 41 | | `REC -> pr "REC\n" 42 | in 43 | List.iter add m; 44 | Buffer.contents b 45 | 46 | (* From assemblage project *) 47 | 48 | let project_ocamlfind_pkgs proj = 49 | let add pkgs p = match Pkg.kind p with 50 | | `OCamlfind -> String.Set.add (Part.name p) pkgs 51 | | _ -> pkgs 52 | in 53 | let init = (String.Set.singleton "assemblage") in 54 | Part.list_fold_kind_rec `Pkg add init (Project.parts proj) 55 | 56 | let of_project p : t = 57 | let add v acc = v :: acc in 58 | let pkgs = project_ocamlfind_pkgs p in 59 | let rev_pkgs = String.Set.fold (fun pkg acc -> `PKG pkg :: acc) pkgs [] in 60 | let rev_ss = 61 | let srcs = Project.products ~kind:`Source p in 62 | let add_dir p acc = match Path.ext p with 63 | | ".ml" | ".mli" -> Path.Set.add (Path.parent p) acc 64 | | _ -> acc 65 | in 66 | let ss = Path.Set.fold add_dir srcs Path.Set.empty in 67 | Path.(Set.fold (fun p acc -> `S (to_string p) :: acc) ss []) 68 | in 69 | let rev_bs = 70 | let builds = Project.products ~kind:`Output p in 71 | let add_dir p acc = match Path.ext p with 72 | | ".cmi" | ".cmti" | ".cmt" -> Path.Set.add (Path.parent p) acc 73 | | _ -> acc 74 | in 75 | let bs = Path.Set.fold add_dir builds Path.Set.empty in 76 | Path.(Set.fold (fun p acc -> `B (to_string p) :: acc) bs []) 77 | in 78 | add (`Comment (Project.watermark_string p)) @@ 79 | add `Blank @@ 80 | List.rev_append rev_pkgs (List.rev_append rev_ss (List.rev rev_bs)) 81 | -------------------------------------------------------------------------------- /lib-driver/ast_merlin.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 David Sheets 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | (** Merlin support. 19 | 20 | See {!Assemblage_tools.Merlin}. *) 21 | 22 | (** {1 Merlin project file} *) 23 | 24 | type directive = 25 | [ `REC | `S of string | `B of string | `PKG of string 26 | | `FLG of string list | `EXT of string list ] 27 | 28 | type t = [ `Comment of string | `Blank | directive ] list 29 | 30 | val to_string : t -> string 31 | val of_project : Assemblage.project -> t 32 | -------------------------------------------------------------------------------- /lib-driver/ast_meta.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | type t = string 18 | 19 | let to_string m = m 20 | let of_project t = "TODO" 21 | (* 22 | let libs = Part.(keep_map Lib.ocaml) (Project.parts t) in 23 | let buf = Buffer.create 1024 in 24 | let one lib = 25 | let requires = 26 | conmap 27 | Part.deps ([lib]) 28 | |> Part.(keep_map Pkg.ocaml) 29 | |> List.map Part.name 30 | |> String.concat " " 31 | in 32 | let name = Part.name lib in 33 | Printf.bprintf buf "version = \"%s\"\n" version; 34 | Printf.bprintf buf "requires = \"%s\"\n" requires; 35 | Printf.bprintf buf "archive(byte) = \"%s.cma\"\n" name; 36 | Printf.bprintf buf "archive(byte, plugin) = \"%s.cma\"\n" name; 37 | Printf.bprintf buf "archive(native) = \"%s.cmxa\"\n" name; 38 | Printf.bprintf buf "archive(native, plugin) = \"%s.cmxs\"\n" name; 39 | Printf.bprintf buf "exist_if = \"%s.cma\"\n" name 40 | in 41 | List.iteri (fun i lib -> 42 | if i = 0 then one lib 43 | else ( 44 | Printf.bprintf buf "package \"%s\" (" (Part.name lib); 45 | one lib; 46 | Printf.bprintf buf ")\n" 47 | ) 48 | ) libs; 49 | Buffer.contents buf 50 | *) 51 | -------------------------------------------------------------------------------- /lib-driver/ast_meta.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | (** Findlib META support. 18 | 19 | See {!Assemblage_tools.Meta}. *) 20 | 21 | (** {1 META files} *) 22 | 23 | type t 24 | 25 | val of_project : Assemblage.project -> t 26 | val to_string : t -> string 27 | -------------------------------------------------------------------------------- /lib-driver/ast_opam.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | open Assemblage 19 | open Assemblage.Private 20 | 21 | (* Metadata synchronization *) 22 | 23 | module Sync = struct 24 | 25 | (* Heeeeeeeeeelp ! *) 26 | 27 | end 28 | 29 | (* Install files *) 30 | 31 | module Install = struct 32 | 33 | type move = Path.t * Path.t option * bool 34 | 35 | let move ?(maybe = false) ?dst src = (src, dst, maybe) 36 | 37 | type field_elt = 38 | [ `Bin of move | `Doc of move | `Etc of move | `Lib of move | `Man of move 39 | | `Misc of move | `Sbin of move | `Share of move | `Share_root of move 40 | | `Stublibs of move | `Toplevel of move ] 41 | 42 | let str_field_elt = function 43 | | `Bin m -> "bin", m 44 | | `Doc m -> "doc", m 45 | | `Etc m -> "etc", m 46 | | `Lib m -> "lib", m 47 | | `Man m -> "man", m 48 | | `Misc m -> "misc", m 49 | | `Sbin m -> "sbin", m 50 | | `Share m -> "share", m 51 | | `Share_root m -> "share_root", m 52 | | `Stublibs m -> "stublibs", m 53 | | `Toplevel m -> "toplevel", m 54 | 55 | type t = [ `Header of string option ] * field_elt list 56 | 57 | let to_string (`Header header, moves) = 58 | let b = Buffer.create 1024 in 59 | let pr fmt = Printf.bprintf b fmt in 60 | let add_move last (field, (src, dst, maybe)) = 61 | if last = field then pr "\n \"" else 62 | begin 63 | if last <> "" then (* close last field *) pr " ]\n"; 64 | pr "%s: [\n \"" field; 65 | end; 66 | if maybe then pr "?"; 67 | pr "%s\"" (Path.to_string src); 68 | begin match dst with 69 | | None -> () 70 | | Some dst -> pr " {\"%s\"}" (Path.to_string dst) 71 | end; 72 | field 73 | in 74 | (match header with None -> () | Some h -> pr "# %s\n\n" h); 75 | let moves = List.sort compare (List.rev_map str_field_elt moves) in 76 | let last = List.fold_left add_move "" moves in 77 | if last <> "" then (* close last field *) pr " ]\n"; 78 | Buffer.contents b 79 | 80 | (* For an assemblage project *) 81 | 82 | let err_abs_output = format_of_string 83 | "`Dir@ part@ has@ an@ absolute@ output@ (%a)@ (custom@ `Dir@ part ?)." 84 | 85 | let err_no_prefix = format_of_string 86 | "`Dir@ part@ product@ (%a) is@ not@ a@ prefix@ of@ part@ directory\ 87 | @ root (%a) (custom `Dir@ part ?)." 88 | 89 | let of_project ?(add = []) proj = 90 | let add_outputs ?prefix dir_root acc outputs elt = 91 | let add_output acc output = match Path.is_rel output with 92 | | false -> Log.err err_abs_output Path.pp output; acc 93 | | true -> 94 | match Path.rem_prefix dir_root output with 95 | | None -> 96 | Log.err err_no_prefix Path.pp output Path.pp dir_root; 97 | acc 98 | | Some dst -> 99 | let dst = match prefix with 100 | | None -> dst 101 | | Some other -> Path.(other // dst) 102 | in 103 | elt (move output ~dst) :: acc 104 | in 105 | List.fold_left add_output acc outputs 106 | in 107 | let add_dir acc dir = 108 | if not (Dir.install dir && Project.eval proj (Part.exists dir)) 109 | then acc else 110 | let dir_root = Project.eval proj (Part.root dir) in 111 | let actions = Project.eval proj (Part.actions dir) in 112 | let outputs = Action.list_outputs actions in 113 | let add_outputs ?prefix = add_outputs ?prefix dir_root acc outputs in 114 | match Dir.kind dir with 115 | | `Bin -> add_outputs (fun m -> `Bin m) 116 | | `Doc -> add_outputs (fun m -> `Doc m) 117 | | `Etc -> add_outputs (fun m -> `Etc m) 118 | | `Lib -> add_outputs (fun m -> `Lib m) 119 | | `Man -> add_outputs (fun m -> `Man m) 120 | | `Other o -> add_outputs ~prefix:o (fun m -> `Misc m) 121 | | `Sbin -> add_outputs (fun m -> `Sbin m) 122 | | `Share -> add_outputs (fun m -> `Share m) 123 | | `Share_root -> add_outputs (fun m -> `Share_root m) 124 | | `Stublibs -> add_outputs (fun m -> `Stublibs m) 125 | | `Toplevel -> add_outputs (fun m -> `Toplevel m) 126 | in 127 | let header = `Header (Some (Project.watermark_string proj)) in 128 | let init = add in 129 | header, Part.list_fold_kind `Dir add_dir init (Project.parts proj) 130 | end 131 | -------------------------------------------------------------------------------- /lib-driver/ast_opam.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | (** OPAM support. 19 | 20 | See {!Assemblage_tools.Opam}. *) 21 | 22 | (** {1 Metadata synchronization} *) 23 | 24 | open Assemblage 25 | 26 | module Sync : sig 27 | 28 | end 29 | 30 | (** {1 Install file} *) 31 | 32 | module Install : sig 33 | 34 | (** {1 Install file} *) 35 | 36 | type move 37 | val move : ?maybe:bool -> ?dst:Path.t -> Path.t -> move 38 | 39 | type field_elt = 40 | [ `Bin of move | `Doc of move | `Etc of move | `Lib of move | `Man of move 41 | | `Misc of move | `Sbin of move | `Share of move | `Share_root of move 42 | | `Stublibs of move | `Toplevel of move ] 43 | 44 | type t = [`Header of string option ] * field_elt list 45 | 46 | val to_string : t -> string 47 | val of_project : ?add:field_elt list -> project -> t 48 | end 49 | -------------------------------------------------------------------------------- /lib/as_acmd.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Daniel C. Bünzli 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | 18 | (* Action commands *) 19 | 20 | open Bos 21 | 22 | type cmd = string As_conf.key option * string 23 | 24 | let cmd k = As_conf.(const (fun k v -> Some k, v) $ const k $ value k) 25 | let static n = None, n 26 | 27 | type t = 28 | { cmd : cmd; (* command. *) 29 | args : string list; (* command arguments. *) 30 | stdin : path option; (* stdin redirection (if any). *) 31 | stdout : path option; (* stdout redirection (if any). *) 32 | stderr : path option; } (* stderr redirection (if any). *) 33 | 34 | let v ?stdin ?stdout ?stderr cmd args = 35 | { cmd; args; stdin; stdout; stderr } 36 | 37 | let cmd_key c = fst c.cmd 38 | let cmd_name c = snd c.cmd 39 | let args c = c.args 40 | let stdin c = c.stdin 41 | let stdout c = c.stdout 42 | let stderr c = c.stderr 43 | 44 | let pp ppf c = 45 | let pp_redir fdname ppf = function 46 | | None -> () 47 | | Some p -> Fmt.pf ppf "%s %s" fdname (Path.to_string p) 48 | in 49 | Fmt.pf ppf "@[%a%s @[%a%a%a%a@]@]" 50 | Fmt.(option (fun ppf k -> Fmt.pf ppf "%s:" (As_conf.Key.name k))) 51 | (cmd_key c) 52 | (cmd_name c) 53 | Fmt.(list ~sep:sp string) c.args 54 | (pp_redir "<") c.stdin 55 | (pp_redir "1>") c.stdout 56 | (pp_redir "2>") c.stderr 57 | 58 | let ctx context c = 59 | let elt = match fst c.cmd with 60 | | None -> `Cmd_static (snd c.cmd) 61 | | Some k -> `Cmd k 62 | in 63 | As_ctx.add elt context 64 | 65 | let args_with_ctx conf context args c = 66 | let injected = As_args.for_ctx conf (ctx context c) args in 67 | List.rev_append (List.rev injected) c.args 68 | 69 | module Args = struct 70 | let add a al = a :: al 71 | let adds al al' = List.rev_append (List.rev al) al' 72 | let add_if c a al = if c then add a al else al 73 | let adds_if c al al' = if c then adds al al' else al' 74 | let fadd_if c f v al = if c then add (f v) al else al 75 | let fadds_if c f v al = if c then adds (f v) al else al 76 | let path_arg ?opt p al = match opt with 77 | | None -> Path.to_string p :: al 78 | | Some opt -> opt :: Path.to_string p :: al 79 | 80 | let path_args ?opt ps al = match opt with 81 | | None -> List.rev_append (List.rev_map Path.to_string ps) al 82 | | Some opt -> 83 | let add acc p = (Path.to_string p) :: opt :: acc in 84 | List.rev_append (List.fold_left add [] ps) al 85 | 86 | let path p ~ext = Path.set_ext p ext 87 | end 88 | 89 | (** {1 Portable system utility invocations} *) 90 | 91 | open Args 92 | 93 | let dev_null = 94 | let dev_null os = match os with 95 | | "Win32" -> Path.v "NUL" 96 | | _ -> Path.(root / "dev" / "null") 97 | in 98 | As_conf.(const dev_null $ value host_os) 99 | 100 | let cd = 101 | let make_cmd cd = fun dir -> v cd (path_arg dir @@ []) in 102 | As_conf.(const make_cmd $ cmd As_conf.cd) 103 | 104 | let ln = 105 | let make_cmd os ln = match os with 106 | | "Win32" -> 107 | (* TODO *) 108 | Log.warn "Symbolic@ links@ unsupported@ copying@ instead."; 109 | fun src dst -> v ln (add "/Y" @@ path_arg src @@ path_arg dst @@ []) 110 | | _ -> 111 | fun src dst -> 112 | let args = adds ["-s"; "-f"] @@ path_arg src @@ path_arg dst @@ [] in 113 | v ln args 114 | in 115 | As_conf.(const make_cmd $ (value host_os) $ (cmd As_conf.ln )) 116 | 117 | let ln_rel = 118 | let relativize ~root src = (* src as seen from dst, as short as possible *) 119 | match Path.relativize ~root src with 120 | | None -> assert false (* TODO *) 121 | | Some p -> p 122 | in 123 | let make_cmd ln src dst = ln (relativize ~root:dst src) dst in 124 | let ln_cmd = ln in 125 | As_conf.(const make_cmd $ ln_cmd) 126 | 127 | let cp = 128 | let make_cmd os cp = match os with 129 | | "Win32" -> 130 | fun src dst -> v cp (add "/Y" @@ path_arg src @@ path_arg dst @@ []) 131 | | _ -> 132 | fun src dst -> v cp (path_arg src @@ path_arg dst @@ []) 133 | in 134 | As_conf.(const make_cmd $ value host_os $ cmd As_conf.cp) 135 | 136 | let mv = 137 | let make_cmd os mv = match os with 138 | | "Win32" -> 139 | fun src dst -> v mv (add "/Y" @@ path_arg src @@ path_arg dst @@ []) 140 | | _ -> 141 | fun src dst -> v mv (path_arg src @@ path_arg dst @@ []) 142 | in 143 | As_conf.(const make_cmd $ value host_os $ cmd As_conf.mv) 144 | 145 | let rm_files = 146 | let make_cmd os rm = match os with 147 | | "Win32" -> 148 | fun ?(f = false) paths -> 149 | v rm (add_if f "/F" @@ add "/Q" @@ path_args paths @@ []) 150 | | _ -> 151 | fun ?(f = false) paths -> 152 | v rm (add_if f "-f" @@ path_args paths @@ []) 153 | in 154 | As_conf.(const make_cmd $ value host_os $ cmd As_conf.rm) 155 | 156 | let rm_dirs = 157 | let make_cmd os rmdir = match os with 158 | | "Win32" -> 159 | fun ?(f = false) ?(r = false) paths -> 160 | v rmdir (add_if f "/F" @@ add_if r "/S" @@ add "/Q" @@ 161 | path_args paths @@ []) 162 | | _ -> 163 | fun ?(f = false) ?(r = false) paths -> 164 | v rmdir (add_if f "-f" @@ add_if r "-r" @@ path_args paths @@ []) 165 | in 166 | As_conf.(const make_cmd $ value host_os $ cmd As_conf.rmdir) 167 | 168 | let mkdir = 169 | let make_cmd os mkdir = match os with 170 | | "Win32" -> fun dir -> v mkdir (path_arg dir @@ []) 171 | | _ -> fun dir -> v mkdir (add "-p" @@ path_arg dir @@ []) 172 | in 173 | As_conf.(const make_cmd $ value host_os $ cmd As_conf.mkdir) 174 | 175 | let stamp = 176 | let make_cmds cmd file contents = v cmd [contents] ~stdout:file in 177 | As_conf.(const make_cmds $ cmd As_conf.echo) 178 | -------------------------------------------------------------------------------- /lib/as_acmd.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Daniel C. Bünzli 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | (** Build action commands 18 | 19 | See {!Assemblage.Acmd}. *) 20 | 21 | (** {1 Action commands} *) 22 | 23 | open Bos 24 | 25 | type cmd 26 | val cmd : string As_conf.key -> cmd As_conf.value 27 | val static : string -> cmd 28 | 29 | type t 30 | 31 | val v : ?stdin:path -> ?stdout:path -> ?stderr:path -> cmd -> 32 | string list -> t 33 | 34 | val cmd_key : t -> string As_conf.key option 35 | val cmd_name : t -> string 36 | val args : t -> string list 37 | val stdin : t -> path option 38 | val stdout : t -> path option 39 | val stderr : t -> path option 40 | 41 | val pp : Format.formatter -> t -> unit 42 | val ctx : As_ctx.t -> t -> As_ctx.t 43 | val args_with_ctx : As_conf.t -> As_ctx.t -> As_args.t -> t -> string list 44 | 45 | (** Action command arguments combinators. *) 46 | module Args : sig 47 | val add : 'a -> 'a list -> 'a list 48 | val adds : 'a list -> 'a list -> 'a list 49 | val add_if : bool -> 'a -> 'a list -> 'a list 50 | val adds_if : bool -> 'a list -> 'a list -> 'a list 51 | val fadd_if : bool -> ('b -> 'a) -> 'b -> 'a list -> 'a list 52 | val fadds_if : bool -> ('b -> 'a list) -> 'b -> 'a list -> 'a list 53 | val path_arg : ?opt:string -> path -> string list -> string list 54 | val path_args : ?opt:string -> path list -> string list -> string list 55 | val path : path -> ext:Path.ext -> path 56 | end 57 | 58 | (** {1 Portable system utility invocations} *) 59 | 60 | val dev_null : path As_conf.value 61 | val cd : (path -> t) As_conf.value 62 | val ln : (path -> path -> t) As_conf.value 63 | val ln_rel : (path -> path -> t) As_conf.value 64 | val cp : (path -> path -> t) As_conf.value 65 | val mv : (path -> path -> t) As_conf.value 66 | val rm_files : (?f:bool -> path list -> t) As_conf.value 67 | val rm_dirs : (?f:bool -> ?r:bool -> path list -> t) As_conf.value 68 | val mkdir : (path -> t) As_conf.value 69 | val stamp : (path -> string -> t) As_conf.value 70 | -------------------------------------------------------------------------------- /lib/as_action.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Daniel C. Bünzli 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | (* Actions *) 18 | 19 | open Bos 20 | 21 | type t = 22 | { ctx : As_ctx.t; (* context to use on evaluation. *) 23 | inputs : path list; (* inputs that need to exist and be up to date. *) 24 | outputs : path list; (* outputs that need to be touched by cmds. *) 25 | cmds : As_acmd.t list; (* action commands. *) 26 | args : As_args.t; (* argument bundle to use on evaluation. *) 27 | log : string option; } (* a high-level logging string for the action. *) 28 | 29 | let v ?log ?(ctx = As_ctx.empty) ?(inputs = []) ?(outputs = []) cmds = 30 | { args = As_args.empty; log; ctx; inputs; outputs; cmds } 31 | 32 | let ctx a = a.ctx 33 | let inputs a = a.inputs 34 | let outputs a = a.outputs 35 | let cmds a = a.cmds 36 | let args a = a.args 37 | let log a = a.log 38 | let products a = List.(rev_append (rev (inputs a)) (outputs a)) 39 | 40 | let add_cmds loc cmds a = 41 | let cmds = match loc with 42 | | `Before -> List.rev_append (List.rev cmds) a.cmds 43 | | `After -> List.rev_append (List.rev a.cmds) cmds 44 | in 45 | {a with cmds = cmds } 46 | 47 | let add_ctx_args ctx args a = 48 | { a with ctx = As_ctx.union ctx a.ctx; args = As_args.append args a.args } 49 | 50 | let pp conf ppf a = 51 | Fmt.pf ppf 52 | "@[ ctx: @[%a@]@, inputs: @[%a@]@,outputs: @[%a@]@, cmds: @[%a@]\ 53 | @, args: @[%a@]@, log: %a@]" 54 | As_ctx.pp a.ctx 55 | Fmt.(list ~sep:sp Path.pp) a.inputs 56 | Fmt.(list ~sep:sp Path.pp) a.outputs 57 | Fmt.(list ~sep:cut As_acmd.pp) a.cmds 58 | (As_args.pp conf) a.args 59 | Fmt.(option string) a.log 60 | 61 | (* Action lists *) 62 | 63 | let list_field field acc acts = 64 | let add_action acc a = List.rev_append (field a) acc in 65 | List.rev (List.fold_left add_action acc acts) 66 | 67 | let list_inputs acts = list_field inputs [] acts 68 | let list_outputs acts = list_field outputs [] acts 69 | let list_products acts = list_field inputs (list_field outputs [] acts) acts 70 | 71 | (* Build actions *) 72 | 73 | let symlink = 74 | let action ln_rel src dst = 75 | v ~ctx:As_ctx.empty ~inputs:[src] ~outputs:[dst] [ln_rel src dst] 76 | in 77 | As_conf.(const action $ As_acmd.ln_rel) 78 | -------------------------------------------------------------------------------- /lib/as_action.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Daniel C. Bünzli 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | (** Build actions. 18 | 19 | See {!Assemblage.Action}. *) 20 | 21 | (** {1 Actions} *) 22 | 23 | open Bos 24 | 25 | type t 26 | 27 | val v : ?log:string -> ?ctx:As_ctx.t -> ?inputs:path list -> 28 | ?outputs:path list -> As_acmd.t list -> t 29 | 30 | val ctx : t -> As_ctx.t 31 | val inputs : t -> path list 32 | val outputs : t -> path list 33 | val cmds : t -> As_acmd.t list 34 | val args : t -> As_args.t 35 | val log : t -> string option 36 | val products : t -> path list 37 | 38 | val add_cmds : [`Before | `After] -> As_acmd.t list -> t -> t 39 | val add_ctx_args : As_ctx.t -> As_args.t -> t -> t 40 | (** [add_ctx_args ctx args t] adds context [ctx] and argument bundle [args] 41 | to [t]. This is used by parts to watermark their actions 42 | on {!As_part.actions}. *) 43 | 44 | val pp : As_conf.t -> Format.formatter -> t -> unit 45 | 46 | (** {1 Action lists} *) 47 | 48 | val list_inputs : t list -> path list 49 | val list_outputs : t list -> path list 50 | val list_products : t list -> path list 51 | 52 | (** {1 Build actions} *) 53 | 54 | val symlink : (path -> path -> t) As_conf.value 55 | -------------------------------------------------------------------------------- /lib/as_action_ocaml.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Daniel C. Bünzli 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | (** Built-in actions for OCaml. 18 | 19 | The strategy is the following. At this level we only deal 20 | with unlifted actions and we are concerned about the command 21 | options that deal with inputs and output specification (e.g. 22 | [-bin-annot] or packages, but not [-g]). *) 23 | 24 | (** {1 Types} *) 25 | 26 | open Bos 27 | 28 | type includes = path list 29 | type name = path 30 | type pkgs = As_ctx.t -> string list 31 | 32 | (** {1 Preprocess} *) 33 | 34 | val compile_src_ast : 35 | ?needs:path list -> ?pkgs:pkgs -> ?args:string list -> 36 | dumpast:As_acmd.cmd -> 37 | [`Ml | `Mli] -> src:path -> unit -> 38 | As_action.t 39 | 40 | (** {1 Dependencies} *) 41 | 42 | val prepare: 43 | stamp:(path -> string -> As_acmd.t) -> src:path -> As_action.t 44 | 45 | val compute_deps_mli: 46 | ?needs:path list -> ?pkgs:pkgs -> ?args:string list -> 47 | ocamldep:As_acmd.cmd -> 48 | incs:includes -> src:path -> unit -> 49 | As_action.t 50 | 51 | val compute_deps_ml: 52 | ?needs:path list -> ?pkgs:pkgs -> ?args:string list -> 53 | ocamldep:As_acmd.cmd -> 54 | incs:includes -> src:path -> unit -> 55 | As_action.t 56 | 57 | (** {1 Compiling} *) 58 | 59 | val compile_mli : 60 | ?needs:path list -> ?pkgs:pkgs -> ?args:string list -> 61 | ocamlc:As_acmd.cmd -> 62 | annot:bool -> incs:includes -> target:[`Target of [`Byte|`Native]] -> 63 | src:path -> unit -> 64 | As_action.t 65 | 66 | val compile_ml_byte : 67 | ?needs:path list -> ?pkgs:pkgs -> ?args:string list -> 68 | ocamlc:As_acmd.cmd -> 69 | annot:bool -> has_mli:bool -> incs:includes -> src:path -> unit -> 70 | As_action.t 71 | 72 | val compile_ml_native : 73 | ?needs:path list -> ?pkgs:pkgs -> ?args:string list -> 74 | ocamlopt:As_acmd.cmd -> 75 | annot:bool -> has_mli:bool -> incs:includes -> src:path -> unit -> 76 | As_action.t 77 | 78 | val compile_c : 79 | ?needs:path list -> ?pkgs:pkgs -> ?args:string list -> 80 | ocamlc:As_acmd.cmd -> 81 | src:path -> unit -> 82 | As_action.t 83 | 84 | (** {1 Archiving} *) 85 | 86 | val archive_byte : 87 | ?needs:path list -> ?pkgs:pkgs -> ?args:string list -> 88 | ocamlc:As_acmd.cmd -> 89 | cmos:path list -> name:name -> unit -> 90 | As_action.t 91 | 92 | val archive_native : 93 | ?needs:path list -> ?pkgs:pkgs -> ?args:string list -> 94 | ocamlopt:As_acmd.cmd -> 95 | cmx_s:path list -> name:name -> unit -> 96 | As_action.t 97 | 98 | val archive_shared : 99 | ?needs:path list -> ?pkgs:pkgs -> ?args:string list -> 100 | ocamlopt:As_acmd.cmd -> 101 | cmx_s:path list -> name:name -> unit -> 102 | As_action.t 103 | 104 | val archive_c : 105 | ?needs:path list -> ?pkgs:pkgs -> ?args:string list -> 106 | ocamlmklib:As_acmd.cmd -> 107 | objs:path list -> name:name -> unit -> 108 | As_action.t 109 | 110 | (** {1 Linking} *) 111 | 112 | val link_byte : 113 | ?needs:path list -> ?pkgs:pkgs -> ?args:string list -> 114 | ocamlc:As_acmd.cmd -> 115 | objs:path list -> name:name -> unit -> 116 | As_action.t 117 | 118 | val link_native : 119 | ?needs:path list -> ?pkgs:pkgs -> ?args:string list -> 120 | ocamlopt:As_acmd.cmd -> 121 | objs:path list -> name:name -> unit -> 122 | As_action.t 123 | -------------------------------------------------------------------------------- /lib/as_args.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | let str = Printf.sprintf 19 | 20 | (* Arguments with conditions *) 21 | 22 | type cargs = { exists : bool As_conf.value; args : string list As_conf.value } 23 | let cargs_exists ca = ca.exists 24 | let cargs_args ca = ca.args 25 | let cargs_deps ca = As_conf.(Key.Set.union (deps ca.exists) (deps ca.args)) 26 | let cargs_pp conf ppf ca = 27 | Fmt.pf ppf "@[<1>[exists:%b %a]@]" (As_conf.eval conf ca.exists) 28 | Fmt.(list ~sep:sp string) (As_conf.eval conf ca.args) 29 | 30 | (* Argument bundles *) 31 | 32 | module Cmap = Map.Make (As_ctx) 33 | 34 | type t = cargs list Cmap.t (* maps ctxs to list of conditionalized args *) 35 | 36 | let v ?(exists = As_conf.true_) ctx args = Cmap.singleton ctx [{exists; args}] 37 | let vc ?exists ctx args = v ?exists ctx (As_conf.const args) 38 | let empty = Cmap.empty 39 | let is_empty = Cmap.is_empty 40 | let append a0 a1 = 41 | let merge _ v v' = match v, v' with 42 | | Some cl, Some cl' -> Some (List.rev_append (List.rev cl) cl') 43 | | (Some _ as cl), None | None, (Some _ as cl) -> cl 44 | | None, None -> assert false 45 | in 46 | Cmap.merge merge a0 a1 47 | 48 | let ( @@@ ) = append 49 | let concat al = List.fold_left append empty al 50 | let bindings = Cmap.bindings 51 | 52 | let deps a = 53 | let add_carg acc cargs = As_conf.Key.Set.union acc (cargs_deps cargs) in 54 | let add_ctx _ cargss acc = List.fold_left add_carg acc cargss in 55 | Cmap.fold add_ctx a As_conf.Key.Set.empty 56 | 57 | let cargs_for_ctx ctx a = 58 | let add bctx cargs_list acc = 59 | if not (As_ctx.matches bctx ctx) then acc else 60 | List.rev_append cargs_list acc 61 | in 62 | List.rev (Cmap.fold add a []) 63 | 64 | let for_ctx conf ctx a = 65 | let cargs = cargs_for_ctx ctx a in 66 | let add acc cargs = 67 | if not (As_conf.eval conf cargs.exists) then acc else 68 | let args = As_conf.eval conf cargs.args in 69 | List.rev_append args acc 70 | in 71 | List.rev (List.fold_left add [] cargs) 72 | 73 | let pp conf ppf args = 74 | let pp_binding ppf (ctx, cargs) = 75 | Fmt.pf ppf "@[<2>%a %a@]" 76 | As_ctx.pp ctx Fmt.(list ~sep:sp (cargs_pp conf)) cargs 77 | in 78 | Fmt.pf ppf "@[%a@]" Fmt.(list pp_binding) (Cmap.bindings args) 79 | 80 | (* Built-in argument bundles *) 81 | 82 | let linkall = 83 | let f = As_conf.const ["-linkall"] in 84 | concat 85 | [ v (As_ctx.v [`OCaml; `Archive `Shared]) f; 86 | v (As_ctx.v [`OCaml; `Link; `Target `Byte]) f; 87 | v (As_ctx.v [`OCaml; `Link; `Target `Native]) f; 88 | v (As_ctx.v [`OCaml; `Link; `Target `Js]) f; ] 89 | 90 | let thread = 91 | let f = As_conf.const ["-thread"] in 92 | concat 93 | [ v (As_ctx.v [`OCaml; `Compile; `Target `Byte]) f; 94 | v (As_ctx.v [`OCaml; `Compile; `Target `Native]) f; 95 | v (As_ctx.v [`OCaml; `Link; `Target `Byte]) f; 96 | v (As_ctx.v [`OCaml; `Link; `Target `Native]) f; ] 97 | 98 | let vmthread = 99 | let f = As_conf.const ["-vmthread"] in 100 | concat 101 | [ v (As_ctx.v [`OCaml; `Compile; `Target `Byte]) f; 102 | v (As_ctx.v [`OCaml; `Link; `Target `Byte]) f; ] 103 | 104 | (* FIXME: which phase? *) 105 | let cclib args = 106 | let f = As_conf.const (List.map (str "-cclib %s") args) in 107 | concat 108 | [ v (As_ctx.v [`OCaml; `Compile; `C]) (As_conf.const args); 109 | v (As_ctx.v [`OCaml; `Link; `Target `Byte]) f; 110 | v (As_ctx.v [`OCaml; `Link; `Target `Byte]) f; ] 111 | 112 | (* FIXME: which phase? *) 113 | let ccopt args = 114 | let f = As_conf.const (List.map (str "-ccopt %s") args) in 115 | concat 116 | [ v (As_ctx.v [`OCaml; `Compile; `Target `Byte]) f; 117 | v (As_ctx.v [`OCaml; `Compile; `Target `Native]) f; 118 | v (As_ctx.v [`C; `Compile]) (As_conf.const args); 119 | v (As_ctx.v [`OCaml; `Link; `Target `Byte]) f; 120 | v (As_ctx.v [`OCaml; `Link; `Target `Native]) f; ] 121 | 122 | (* FIXME: which phase? *) 123 | let stub s = 124 | concat 125 | [ v (As_ctx.v [`OCaml; `Link; `Target `Byte]) 126 | (As_conf.const ["-cclib"; (str "-l%s" s); "-dllib "; (str "-l%s" s)]); 127 | v (As_ctx.v [`OCaml; `Link; `Target `Native]) 128 | (As_conf.const [str "-cclib -l%s" s]); ] 129 | -------------------------------------------------------------------------------- /lib/as_args.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | (** Build argument bundles 19 | 20 | For documentation see {!Assemblage.Args}. *) 21 | 22 | (** {1 Argument bundles} *) 23 | 24 | type t 25 | val v : ?exists:bool As_conf.value -> As_ctx.t -> string list As_conf.value -> t 26 | val vc : ?exists:bool As_conf.value -> As_ctx.t -> string list -> t 27 | val empty : t 28 | val is_empty : t -> bool 29 | val append : t -> t -> t 30 | val ( @@@ ) : t -> t -> t 31 | val concat : t list -> t 32 | val deps : t -> As_conf.Key.Set.t 33 | val for_ctx : As_conf.t -> As_ctx.t -> t -> string list 34 | val pp : As_conf.t -> Format.formatter -> t -> unit 35 | 36 | (** {1 Built-in argument bundles} *) 37 | 38 | val linkall : t 39 | val thread : t 40 | val vmthread : t 41 | val cclib : string list -> t 42 | val ccopt : string list -> t 43 | val stub : string -> t 44 | -------------------------------------------------------------------------------- /lib/as_conf.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Daniel C. Bünzli 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | (** Build configuration. 18 | 19 | See {!Assemblage.Conf} for documentation. *) 20 | 21 | (** {1 Configuration values} *) 22 | 23 | open Rresult 24 | open Bos 25 | 26 | type 'a value 27 | 28 | val const : 'a -> 'a value 29 | val app : ('a -> 'b) value -> 'a value -> 'b value 30 | val ( $ ) : ('a -> 'b) value -> 'a value -> 'b value 31 | val true_ : bool value 32 | val false_ : bool value 33 | val neg : bool value -> bool value 34 | val ( &&& ) : bool value -> bool value -> bool value 35 | val ( ||| ) : bool value -> bool value -> bool value 36 | val pick_if : bool value -> 'a value -> 'a value -> 'a value 37 | 38 | module Option : sig 39 | val wrap : 'a value option -> 'a option value 40 | val some : 'a value -> 'a option value 41 | val get : ?none:'a value -> 'a option value -> 'a value 42 | end 43 | 44 | (** {1 Configuration value converters} *) 45 | 46 | type 'a parser = string -> ('a, R.msg) result 47 | type 'a printer = Format.formatter -> 'a -> unit 48 | type 'a converter = 'a parser * 'a printer 49 | 50 | val parser : 'a converter -> 'a parser 51 | val printer : 'a converter -> 'a printer 52 | 53 | (** {1 Configuration keys} *) 54 | 55 | type 'a key 56 | 57 | module Key : sig 58 | type t = V : 'a key -> t 59 | 60 | val hide_type : 'a key -> t 61 | val equal : t -> t -> bool 62 | val compare : t -> t -> int 63 | 64 | val id : 'a key -> int 65 | val name : 'a key -> string 66 | val public : 'a key -> bool 67 | val converter : 'a key -> 'a converter 68 | val default : 'a key -> 'a value 69 | val doc : 'a key -> string option 70 | val docv : 'a key -> string option 71 | val docs : 'a key -> string option 72 | 73 | module Set : sig 74 | include Set.S with type elt = t 75 | val of_list : elt list -> t 76 | end 77 | 78 | module Map : sig 79 | include Map.S with type key = t 80 | val dom : 'a t -> Set.t 81 | end 82 | end 83 | 84 | val key : ?public:bool -> ?docs:string -> ?docv:string -> ?doc:string -> 85 | string -> 'a converter -> 'a value -> 'a key 86 | 87 | val value : 'a key -> 'a value 88 | val manual_value : Key.Set.t -> 'a -> 'a value 89 | 90 | (** {2 Configuration key value converters} *) 91 | 92 | val bool : bool converter 93 | val int : int converter 94 | val string : string converter 95 | val path : path converter 96 | val abs_path : path converter 97 | val rel_path : path converter 98 | val enum : (string * 'a) list -> 'a converter 99 | val version : (int * int * int * string option) converter 100 | 101 | (** {1 Configurations} *) 102 | 103 | type t 104 | val empty : t 105 | val is_empty : t -> bool 106 | val mem : t -> 'a key -> bool 107 | val add : t -> 'a key -> t 108 | val set : t -> 'a key -> 'a value -> t 109 | val rem : t -> 'a key -> t 110 | val merge : t -> t -> t 111 | val find : t -> 'a key -> 'a value option 112 | val get : t -> 'a key -> 'a value 113 | val domain : t -> Key.Set.t 114 | val of_keys : Key.Set.t -> t 115 | val eval : t -> 'a value -> 'a 116 | val deps : 'a value -> Key.Set.t 117 | val pp : Format.formatter -> t -> unit 118 | 119 | (** {1 Configuration schemes} *) 120 | 121 | type scheme = string * (string * t) 122 | type def 123 | val def : 'a key -> 'a -> def 124 | val defv : 'a key -> 'a value -> def 125 | val scheme : ?doc:string -> ?base:scheme -> string -> def list -> scheme 126 | 127 | (** {1 Configuration error messages} *) 128 | 129 | val pp_key_dup : Format.formatter -> Key.t -> unit 130 | 131 | (** {1 Built-in configuration keys} *) 132 | 133 | (** {1 Project keys} *) 134 | 135 | val project_version : string key 136 | val docs_project : string 137 | val doc_project : string 138 | 139 | (** {2 Machine information keys} *) 140 | 141 | val docs_machine_information : string 142 | val doc_machine_information : string 143 | 144 | val uname : string key 145 | val host_os : string key 146 | val host_arch : string key 147 | val host_word_size : int key 148 | val target_os : string key 149 | val target_arch : string key 150 | val target_word_size : int key 151 | 152 | (** {2 Build directory keys} *) 153 | 154 | val docs_build_directories : string 155 | val doc_build_directories : string 156 | 157 | val root_dir : path key 158 | val build_dir : path key 159 | 160 | (** {2 Build property keys} *) 161 | 162 | val docs_build_properties : string 163 | val doc_build_properties : string 164 | 165 | val debug : bool key 166 | val profile : bool key 167 | val warn_error : bool key 168 | val test : bool key 169 | val doc : bool key 170 | val jobs : int key 171 | 172 | (** {2 OCaml system keys} *) 173 | 174 | val docs_ocaml_system : string 175 | val doc_ocaml_system : string 176 | 177 | val ocaml_native_tools : bool key 178 | val ocaml_version : (int * int * int * string option) key 179 | val ocaml_byte : bool key 180 | val ocaml_native : bool key 181 | val ocaml_native_dynlink : bool key 182 | val ocaml_build_ast : bool key 183 | val ocaml_js : bool key 184 | val ocaml_annot : bool key 185 | val ocaml_dumpast : string key 186 | val ocamlc : string key 187 | val ocamlopt : string key 188 | val js_of_ocaml : string key 189 | val ocamldep : string key 190 | val ocamlmklib : string key 191 | val ocamldoc : string key 192 | val ocamllex : string key 193 | val ocamlyacc : string key 194 | val ocaml : string key 195 | val ocamlrun : string key 196 | val ocamldebug : string key 197 | val ocamlprof : string key 198 | val ocamlfind : string key 199 | val opam : string key 200 | val opam_installer : string key 201 | val opam_admin : string key 202 | 203 | (** {2 C system keys} *) 204 | 205 | val docs_c_system : string 206 | val doc_c_system : string 207 | 208 | val c_dynlink : bool key 209 | val c_js : bool key 210 | val cc : string key 211 | val pkg_config : string key 212 | 213 | (** {2 System utility keys} *) 214 | 215 | val docs_system_utilities : string 216 | val doc_system_utilities : string 217 | 218 | val echo : string key 219 | val cd : string key 220 | val ln : string key 221 | val cp : string key 222 | val mv : string key 223 | val rm : string key 224 | val rmdir : string key 225 | val mkdir : string key 226 | val cat : string key 227 | val make : string key 228 | -------------------------------------------------------------------------------- /lib/as_ctx.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | open Astring 19 | open Bos 20 | 21 | (* Context elements *) 22 | 23 | type tag = [ `Tag of string ] 24 | type language = [ `OCaml | `C | `Js | `Lang of string ] 25 | type build_phase = 26 | [ `Gen | `Dep | `Pp | `Compile | `Archive of [ `Static | `Shared ] | `Link 27 | | `Doc ] 28 | 29 | type source = [ `Src of Path.ext ] 30 | type target = [ `Target of [`Src | `Byte | `Native | `Js | `Other of string ]] 31 | type cmd = [ `Cmd of string As_conf.key | `Cmd_static of string ] 32 | type part_usage = [ `Build | `Dev | `Doc | `Other of string | `Outcome | `Test ] 33 | type part_kind = [ `Base | `Bin | `Dir | `Doc | `Lib | `Pkg | `Run | `Unit ] 34 | type part = [ `Part of [ part_usage | part_kind | `Name of string ]] 35 | 36 | module Elt = struct 37 | type t = [ tag | language | build_phase | source | target | cmd | part ] 38 | 39 | let compare (e : t) (e' : t) = match e, e' with 40 | | `Cmd k0, `Cmd k1 -> As_conf.Key.(compare (V k0) (V k1)) 41 | | `Cmd _, _ | _, `Cmd _ -> -1 42 | | c, c' -> compare c c' 43 | 44 | let pp_target ppf = function 45 | | `Byte -> Fmt.string ppf "byte" 46 | | `Js -> Fmt.string ppf "js" 47 | | `Native -> Fmt.string ppf "native" 48 | | `Other o -> Fmt.string ppf o 49 | | `Src -> Fmt.string ppf "src" 50 | 51 | let pp_kind ppf = function 52 | | `Base -> Fmt.string ppf "base" 53 | | `Bin -> Fmt.string ppf "bin" 54 | | `Dir -> Fmt.string ppf "dir" 55 | | `Doc -> Fmt.string ppf "doc" 56 | | `Lib -> Fmt.string ppf "lib" 57 | | `Pkg -> Fmt.string ppf "pkg" 58 | | `Run -> Fmt.string ppf "run" 59 | | `Unit -> Fmt.string ppf "unit" 60 | 61 | let pp_usage ppf = function 62 | | `Build -> Fmt.string ppf "build" 63 | | `Dev -> Fmt.string ppf "dev" 64 | | `Doc -> Fmt.string ppf "doc" 65 | | `Other s -> Fmt.string ppf s 66 | | `Outcome -> Fmt.string ppf "outcome" 67 | | `Test -> Fmt.string ppf "test" 68 | 69 | let pp ppf = function 70 | | `Archive `Shared -> Fmt.string ppf "archive:shared" 71 | | `Archive `Static -> Fmt.string ppf "archive:static" 72 | | `C -> Fmt.string ppf "c" 73 | | `Cmd k -> Fmt.pf ppf "cmd:%s" (As_conf.Key.name k) 74 | | `Cmd_static n -> Fmt.pf ppf "cmd-static:%s" n 75 | | `Compile -> Fmt.string ppf "compile" 76 | | `Dep -> Fmt.string ppf "dep" 77 | | `Doc -> Fmt.string ppf "doc" 78 | | `Gen -> Fmt.string ppf "gen" 79 | | `Js -> Fmt.string ppf "js" 80 | | `Lang l -> Fmt.pf ppf "lang:%s" l 81 | | `Link -> Fmt.string ppf "link" 82 | | `OCaml -> Fmt.string ppf "ocaml" 83 | | `Part (#part_kind as k) -> Fmt.pf ppf "part-kind:%a" pp_kind k 84 | | `Part (#part_usage as u) -> Fmt.pf ppf "part-usage:%a" pp_usage u 85 | | `Part (`Name n) -> Fmt.pf ppf "part-name:%s" n 86 | | `Pp -> Fmt.string ppf "pp" 87 | | `Src ext -> Fmt.pf ppf "src:%a" Fmt.string ext 88 | | `Tag t -> Fmt.pf ppf "tag:%s" t 89 | | `Target t -> Fmt.pf ppf "target:%a" pp_target t 90 | end 91 | 92 | let pp_elt = Elt.pp 93 | let pp_kind = Elt.pp_kind 94 | let pp_usage = Elt.pp_usage 95 | 96 | (* Contexts *) 97 | 98 | include Set.Make (Elt) 99 | 100 | let v elts = List.fold_left (fun acc e -> add e acc) empty elts 101 | let matches = subset 102 | 103 | let pp ppf c = 104 | let sep ppf () = Fmt.pf ppf ",@ " in 105 | Fmt.list ~sep pp_elt ppf (elements c) 106 | -------------------------------------------------------------------------------- /lib/as_ctx.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | (** Command contexts 19 | 20 | For documentation see {!Assemblage.Ctx}. *) 21 | 22 | (** {1 Context elements} *) 23 | 24 | open Bos 25 | 26 | type tag = [ `Tag of string ] 27 | type language = [ `OCaml | `C | `Js | `Lang of string ] 28 | type build_phase = 29 | [ `Gen | `Dep | `Pp | `Compile | `Archive of [ `Static | `Shared ] | `Link 30 | | `Doc ] 31 | 32 | type source = [ `Src of Path.ext ] 33 | type target = [ `Target of [`Src | `Byte | `Native | `Js | `Other of string ]] 34 | type cmd = [ `Cmd of string As_conf.key | `Cmd_static of string ] 35 | type part_usage = [ `Build | `Dev | `Doc | `Other of string | `Outcome | `Test ] 36 | type part_kind = [ `Base | `Bin | `Dir | `Doc | `Lib | `Pkg | `Run | `Unit ] 37 | type part = [ `Part of [ part_usage | part_kind | `Name of string ]] 38 | type elt = [ tag | language | build_phase | source | target | cmd | part ] 39 | 40 | val pp_elt : Format.formatter -> elt -> unit 41 | val pp_kind : Format.formatter -> part_kind -> unit 42 | val pp_usage : Format.formatter -> part_usage -> unit 43 | 44 | (** {1 Contexts} *) 45 | 46 | type t 47 | val v : elt list -> t 48 | include Set.S with type elt := elt 49 | and type t := t 50 | 51 | val pp : Format.formatter -> t -> unit 52 | val matches : t -> t -> bool 53 | -------------------------------------------------------------------------------- /lib/as_misc.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2015 Daniel C. Bünzli 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | 18 | 19 | open Bos 20 | 21 | 22 | let log_driver_fault ?header l fmt = 23 | Log.msg ?header l ("[%a] " ^^ fmt) (Fmt.styled_string `Red) "DRIVER FAULT" 24 | -------------------------------------------------------------------------------- /lib/as_misc.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2015 Daniel C. Bünzli 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | open Bos 18 | 19 | val log_driver_fault : ?header:string -> Log.level -> 20 | ('a, Format.formatter, unit, unit) format4 -> 'a 21 | -------------------------------------------------------------------------------- /lib/as_ocamlfind.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | open Rresult 19 | open Astring 20 | open Bos 21 | 22 | let run_ocamlfind ocamlfind name = 23 | let err pkg _ = R.msgf "Could not lookup ocamlfind package %s" name in 24 | let args preds = 25 | let preds = String.concat ~sep:"," @@ match name with 26 | | "threads.posix" -> "mt" :: "mt_posix" :: preds 27 | | "threads.vm" -> "mt" :: "mt_vm" :: preds 28 | | _ -> preds 29 | in 30 | [ "query"; "-predicates"; preds; "-r"; "-format"; "\"%d|%A|%O\"" ] @ [name] 31 | in 32 | begin 33 | OS.Cmd.exec_read_lines ocamlfind (args ["byte"]) >>= fun byte -> 34 | OS.Cmd.exec_read_lines ocamlfind (args ["native"]) >>= fun native -> 35 | OS.Cmd.exec_read_lines ocamlfind (args ["syntax"; "preprocessor"]) 36 | >>= fun pp -> Ok (byte, native, pp) 37 | end 38 | |> R.reword_error_msg (err name) 39 | |> Log.on_error_msg ~use:([],[],[]) 40 | 41 | type pkg = 42 | { byte_incs : string list; 43 | byte_objs : string list; (* full path *) 44 | byte_link : string list; 45 | native_incs : string list; 46 | native_objs : string list; 47 | native_link : string list; 48 | pp_incs : string list; 49 | pp_objs : string list; } 50 | 51 | let parse_lines (byte, native, pp) = 52 | let add_line (i, o, f as acc) l = 53 | match String.cuts ~sep:"|" l with 54 | | [dir; objs; flags] -> 55 | let objs = String.cuts ~sep:" " objs in 56 | let objs = List.filter ((<>)"") objs in 57 | let objs = List.map (fun obj -> strf "%s/%s" dir obj) objs in 58 | let flags = String.cuts ~sep:" " flags in 59 | let flags = List.filter ((<>)"") flags in 60 | dir :: "-I" :: i, List.rev_append objs o, List.rev_append flags f 61 | | _ -> 62 | Log.err "ocamlfind lookup could not parse line (%s)" l; 63 | acc 64 | in 65 | let parse lines = 66 | let i, o, f = List.fold_left add_line ([], [], []) lines in 67 | List.rev (String.uniquify i), 68 | List.rev (String.uniquify o), 69 | List.rev f 70 | in 71 | let byte_incs, byte_objs, byte_link = parse byte in 72 | let native_incs, native_objs, native_link = parse native in 73 | let pp_incs, pp_objs, _ = parse pp in 74 | { byte_incs; byte_objs; byte_link; 75 | native_incs; native_objs; native_link; 76 | pp_incs; pp_objs; } 77 | 78 | let pkg_lookups ocamlfind name = 79 | let p = run_ocamlfind ocamlfind name |> parse_lines in 80 | [ As_ctx.v [`OCaml; `Pp], p.pp_incs @ p.pp_objs; 81 | As_ctx.v [`OCaml; `Compile; `Target `Byte], p.byte_incs; 82 | As_ctx.v [`OCaml; `Compile; `Target `Native], p.native_incs; 83 | As_ctx.v [`OCaml; `Compile; `Target `Byte; `Src "mli"], p.byte_incs; 84 | As_ctx.v [`OCaml; `Compile; `Target `Native; `Src "mli"], p.native_incs; 85 | As_ctx.v [`OCaml; `Link; `Target `Byte], p.byte_objs @ p.byte_link; 86 | As_ctx.v [`OCaml; `Link; `Target `Native], p.native_objs @ p.native_link; ] 87 | 88 | let lookup name = 89 | let lookups = As_conf.(const pkg_lookups $ (value ocamlfind) $ const name) in 90 | let lookup lookups ctx = 91 | let add acc (pkg_ctx, args) = 92 | if not (As_ctx.matches pkg_ctx ctx) then acc else 93 | List.rev_append (List.rev args) acc 94 | in 95 | List.fold_left add [] lookups 96 | in 97 | As_conf.(const lookup $ lookups) 98 | -------------------------------------------------------------------------------- /lib/as_ocamlfind.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | (** OCamlfind lookup *) 19 | 20 | val lookup : string -> (As_ctx.t -> string list) As_conf.value 21 | -------------------------------------------------------------------------------- /lib/as_part.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | (** Project parts. 19 | 20 | See {!Assemblage.Part}. *) 21 | 22 | open Bos 23 | 24 | (** {1 Part kinds} *) 25 | 26 | type kind = [ `Base | `Unit | `Lib | `Bin | `Pkg | `Run | `Doc | `Dir ] 27 | val pp_kind : Format.formatter -> kind -> unit 28 | 29 | (** {1 Usage} *) 30 | 31 | type usage = [ `Dev | `Test | `Build | `Doc | `Outcome | `Other of string ] 32 | val pp_usage : Format.formatter -> usage -> unit 33 | 34 | (** {1 Metadata} *) 35 | 36 | type meta 37 | val meta_key : unit -> ('a -> meta) * (meta -> 'a option) 38 | val meta_nil : meta 39 | 40 | (** {1 Parts} *) 41 | 42 | type +'a t constraint 'a = [< kind ] 43 | 44 | val v_kind : ?usage:usage -> ?exists:bool As_conf.value -> ?args:As_args.t -> 45 | ?meta:meta -> ?needs:'a t list -> ?root:path As_conf.value -> 46 | ?actions:(kind t -> As_action.t list As_conf.value) -> 47 | ?check:(kind t -> bool As_conf.value) -> 48 | string -> ([< kind] as 'b) -> 'b t 49 | 50 | val v : ?usage:usage -> ?exists:bool As_conf.value -> ?args:As_args.t -> 51 | ?meta:meta -> ?needs:'a t list -> ?root:path As_conf.value -> 52 | ?actions:(kind t -> As_action.t list As_conf.value) -> 53 | ?check:(kind t -> bool As_conf.value) -> 54 | string -> [> `Base] t 55 | 56 | val kind : 'a t -> kind 57 | val name : 'a t -> string 58 | val usage : 'a t -> usage 59 | val exists : 'a t -> bool As_conf.value 60 | val meta : 'a t -> meta 61 | val get_meta : (meta -> 'a option) -> 'b t -> 'a 62 | val needs : 'a t -> kind t list 63 | val root : 'a t -> path As_conf.value 64 | val root_path : 'a t -> path As_conf.value 65 | val args : 'a t -> As_args.t 66 | val actions : 'a t -> As_action.t list As_conf.value 67 | val check : 'a t -> bool As_conf.value 68 | val id : 'a t -> int 69 | val equal : 'a t -> 'b t -> bool 70 | val compare : 'a t -> 'b t -> int 71 | val deps : 'a t -> As_conf.Key.Set.t 72 | val ctx : 'a t -> As_ctx.t 73 | val redefine : 74 | ?check:(kind t -> bool As_conf.value) -> 75 | ?actions:(kind t -> As_action.t list As_conf.value) -> 'a t -> 'a t 76 | 77 | (** {1 Part integration} *) 78 | 79 | val integrate : ?add_need:(kind t -> bool) -> 'a t -> 'b t -> 'a t 80 | 81 | (** {1 Coercions} *) 82 | 83 | val coerce : ([< kind] as 'b) -> 'a t -> 'b t 84 | val coerce_if : ([< kind] as 'b) -> 'a t -> 'b t option 85 | 86 | (** {1 File part} *) 87 | 88 | val file : ?usage:usage -> ?exists:bool As_conf.value -> path -> 89 | [> `Base] t 90 | 91 | (** {1 Part lists} *) 92 | 93 | val list_actions : kind t list -> As_action.t list As_conf.value 94 | val list_uniquify : kind t list -> kind t list 95 | val list_keep : ('a t -> bool) -> 'a t list -> 'a t list 96 | val list_keep_map : ('a t -> 'b option) -> 'a t list -> 'b list 97 | val list_keep_kind : ([< kind] as 'b) -> 'a t list -> 'b t list 98 | val list_keep_kinds : kind list -> 'a t list -> 'a t list 99 | val list_fold : ('a -> 'b t -> 'a) -> 'a -> 'b t list -> 'a 100 | val list_fold_kind : ([< kind] as 'b) -> ('a -> 'b t -> 'a) -> 'a -> 101 | 'c t list -> 'a 102 | 103 | val list_fold_rec : ('a -> kind t -> 'a) -> 'a -> kind t list -> 'a 104 | val list_fold_kind_rec : ([< kind] as 'b) -> ('a -> 'b t -> 'a) -> 'a -> 105 | kind t list -> 'a 106 | 107 | (** {1 Part sets and maps} *) 108 | 109 | module Set : sig 110 | include Set.S with type elt = kind t 111 | val of_list : elt list -> t 112 | end 113 | 114 | module Map : sig 115 | include Map.S with type key = kind t 116 | val dom : 'a t -> Set.t 117 | end 118 | -------------------------------------------------------------------------------- /lib/as_part_bin.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | (** Binary executable part. 19 | 20 | See {!Assemblage.Bin} *) 21 | 22 | open Bos 23 | 24 | (** {1 Metadata} *) 25 | 26 | type kind = [ `OCaml | `OCaml_toplevel | `C ] 27 | val pp_kind : Format.formatter -> kind -> unit 28 | val kind : [< `Bin] As_part.t -> kind 29 | val byte : [< `Bin] As_part.t -> bool 30 | val native : [< `Bin] As_part.t -> bool 31 | val js : [< `Bin] As_part.t -> bool 32 | val ocaml : 'a As_part.t -> [> `Bin] As_part.t option 33 | val ocaml_toplevel : 'a As_part.t -> [> `Bin] As_part.t option 34 | val c : 'a As_part.t -> [> `Bin] As_part.t option 35 | 36 | (** {1 Bin} *) 37 | 38 | val v : 39 | ?usage:As_part.usage -> 40 | ?exists:bool As_conf.value -> 41 | ?args:As_args.t -> 42 | ?byte:bool -> ?native:bool -> ?js:bool -> string -> kind -> 43 | [< `Unit | `Lib | `Pkg ] As_part.t list -> 44 | [> `Bin] As_part.t 45 | 46 | val to_cmd : ?ext:Path.ext -> [< `Bin] As_part.t -> 47 | As_acmd.cmd As_conf.value 48 | 49 | val to_cmd_path : ?abs:bool -> ?ext:Path.ext -> [< `Bin] As_part.t -> 50 | path As_conf.value 51 | 52 | val exists : ?ext:Path.ext -> [< `Bin] As_part.t -> bool As_conf.value 53 | 54 | val gen : ?usage:As_part.usage -> ?exists:bool As_conf.value -> 55 | ?args:As_args.t -> ?dir:path As_conf.value -> ?name:string -> 56 | ?ext:Path.ext -> ?stdin:path As_conf.value -> 57 | ?stdout:path As_conf.value -> ?stderr:path As_conf.value -> 58 | [< `Bin] As_part.t -> string list As_conf.value -> [> `Base] As_part.t 59 | -------------------------------------------------------------------------------- /lib/as_part_dir.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | open Astring 19 | open Bos 20 | 21 | (* Metadata *) 22 | 23 | type kind = [ `Lib | `Bin | `Sbin | `Toplevel | `Share | `Share_root 24 | | `Etc | `Doc | `Stublibs | `Man | `Other of Path.t ] 25 | 26 | let pp_kind ppf kind = Fmt.string ppf begin match kind with 27 | | `Lib -> "lib" | `Bin -> "bin" | `Sbin -> "sbin" | `Toplevel -> "toplevel" 28 | | `Share -> "share" | `Share_root -> "share_root" | `Etc -> "etc" 29 | | `Doc -> "doc" | `Stublibs -> "stublibs" | `Man -> "man" 30 | | `Other p -> strf "other:%s" (Path.to_string p) 31 | end 32 | 33 | let name_of_kind = function 34 | | `Other p -> Path.filename p 35 | | kind -> strf "%a" pp_kind kind 36 | 37 | type meta = { kind : kind; install : bool } 38 | 39 | let inj, proj = As_part.meta_key () 40 | let get_meta p = As_part.get_meta proj p 41 | let meta ?install kind = 42 | let install = match install with 43 | | Some install -> install 44 | | None -> match kind with `Other _ -> false | _ -> true 45 | in 46 | inj { kind; install } 47 | 48 | let kind p = (get_meta p).kind 49 | let install p = (get_meta p).install 50 | 51 | (* Directory specifiers *) 52 | 53 | type spec = As_part.kind As_part.t -> (path * path option) list As_conf.value 54 | 55 | let keep_if kind pred p = 56 | let keep_if acts = 57 | let add acc p = if pred p then (p, None) :: acc else acc in 58 | List.(rev (fold_left add [] (kind acts))) 59 | in 60 | As_conf.(const keep_if $ As_part.actions p) 61 | 62 | let keep_map kind f p = 63 | let keep_map f acts = 64 | let add acc p = match f p with None -> acc | Some spec -> spec :: acc in 65 | List.(rev (fold_left add [] (kind acts))) 66 | in 67 | As_conf.(const keep_map $ f $ As_part.actions p) 68 | 69 | let all kind p = 70 | let all acts = List.(rev (rev_map (fun p -> p, None) (kind acts))) in 71 | As_conf.(const all $ As_part.actions p) 72 | 73 | let all_input = all As_action.list_inputs 74 | let all_output = all As_action.list_outputs 75 | let all = all As_action.list_products 76 | 77 | let file_exts exts = 78 | let ext_matches exts p = List.exists (fun ext -> Path.ext_is ext p) exts in 79 | keep_if As_action.list_products (ext_matches exts) 80 | 81 | let relativize root p = match Path.rem_prefix root p with 82 | | None -> Path.base p 83 | | Some p -> p 84 | 85 | let bin p = match As_part.coerce_if `Bin p with 86 | | None -> all_output p 87 | | Some bin -> 88 | match As_part_bin.kind bin with 89 | | `OCaml_toplevel -> all_output p (* FIXME *) 90 | | `OCaml -> 91 | let spec ocaml_native root f = 92 | let rename f = f, Some (Path.rem_ext (relativize root f)) in 93 | match Path.ext f with 94 | | ".byte" when As_part_bin.native bin && ocaml_native -> None 95 | | ".byte" -> Some (rename f) 96 | | ".native" -> Some (rename f) 97 | | _ -> None 98 | in 99 | keep_map As_action.list_outputs 100 | As_conf.(const spec $ value ocaml_native $ As_part.root_path bin) 101 | bin 102 | | `C -> 103 | let is_exec f = Path.(filename (rem_ext f)) = As_part.name bin in 104 | keep_if As_action.list_outputs is_exec bin 105 | 106 | 107 | let warn_miss_unit = format_of_string 108 | "Library@ part@ %s:@ no@ compilation@ unit@ found@ for@ product@ %s" 109 | 110 | let lib_ocaml lib f = match Path.ext f with 111 | | "" -> None 112 | | ".cma" | ".cmxa" | ".cmxs" | ".a" | ".so" | ".dll" -> Some (f, None) 113 | | (".cmx" | ".cmi" | ".cmti" as ext) -> 114 | let unit_name = Path.(filename (rem_ext f)) in 115 | begin match As_part_lib.find_unit unit_name lib with 116 | | None -> 117 | Log.warn warn_miss_unit (As_part.name lib) (Path.to_string f); 118 | None 119 | | Some u -> 120 | begin match As_part_unit.kind u with 121 | | `OCaml (_, interface) -> 122 | begin match ext, interface with 123 | | ".cmx", `Normal -> Some (f, None) 124 | | (".cmi" | ".cmti"), (`Normal | `Opaque) -> Some (f, None) 125 | | _ -> None 126 | end 127 | | _ -> None 128 | end 129 | end 130 | | _ -> None 131 | 132 | let lib p = match As_part.coerce_if `Lib p with 133 | | None -> all_output p 134 | | Some lib -> 135 | match As_part_lib.kind lib with 136 | | `C -> file_exts [".dll"; ".so"; ".a"] lib 137 | | `OCaml | `OCaml_pp -> 138 | keep_map As_action.list_outputs As_conf.(const (lib_ocaml lib)) lib 139 | 140 | let doc p = match As_part.coerce_if `Doc p with 141 | | None -> all p 142 | | Some doc when As_part_doc.kind doc = `OCamldoc -> all_output p 143 | | _ -> all p 144 | 145 | (* Checks *) 146 | 147 | let check spec p = 148 | let dir = As_part.coerce `Dir p in 149 | (* Here we could check for example that the directory specifier 150 | returns only products that belong to the part itself. *) 151 | Log.warn "%a part check is TODO" As_part.pp_kind (As_part.kind dir); 152 | As_conf.true_ 153 | 154 | (* Actions *) 155 | 156 | let part_links acc symlink exists part_root specs dir_root = 157 | if not exists then acc else 158 | let add acc (src, dst) = 159 | let dst = match dst with 160 | | Some dst -> dst 161 | | None -> relativize part_root src 162 | in 163 | symlink src Path.(dir_root // dst) :: acc 164 | in 165 | List.fold_left add acc specs 166 | 167 | let actions spec p = 168 | let dir = As_part.coerce `Dir p in 169 | let add_part acc part = 170 | As_conf.(const part_links $ acc $ As_action.symlink $ 171 | As_part.exists part $ As_part.root_path part $ 172 | spec part $ As_part.root_path dir) 173 | in 174 | let actions = List.fold_left add_part (As_conf.const []) (As_part.needs p) in 175 | As_conf.(const List.rev $ actions) 176 | 177 | (* Dir *) 178 | 179 | let default_spec kind spec = match spec with 180 | | Some spec -> spec 181 | | None -> 182 | match kind with 183 | | `Bin -> bin 184 | | `Lib -> lib 185 | | `Doc -> doc 186 | | _ -> all 187 | 188 | let v ?usage ?exists ?args ?spec ?install kind needs = 189 | let spec = default_spec kind spec in 190 | let actions = actions spec in 191 | let check = check spec in 192 | let meta = meta ?install kind in 193 | let name = name_of_kind kind in 194 | As_part.v_kind ?usage ?exists ?args ~meta ~needs ~actions ~check name `Dir 195 | -------------------------------------------------------------------------------- /lib/as_part_dir.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | (** Directory part. 19 | 20 | See {!Assemblage.Dir}. *) 21 | 22 | open Rresult 23 | open Bos 24 | 25 | (** {1 Metadata} *) 26 | 27 | type kind = [ `Lib | `Bin | `Sbin | `Toplevel | `Share | `Share_root 28 | | `Etc | `Doc | `Stublibs | `Man | `Other of path ] 29 | 30 | val pp_kind : Format.formatter -> kind -> unit 31 | 32 | val kind : [< `Dir] As_part.t -> kind 33 | val install : [< `Dir] As_part.t -> bool 34 | 35 | (** {1 Product selectors} *) 36 | 37 | type spec = As_part.kind As_part.t -> 38 | (path * path option) list As_conf.value 39 | 40 | val all : spec 41 | val all_output : spec 42 | val all_input : spec 43 | val file_exts : Path.ext list -> spec 44 | val bin : spec 45 | val lib : spec 46 | val doc : spec 47 | 48 | (** {1 Dir} *) 49 | 50 | val v : ?usage:As_part.usage -> ?exists:bool As_conf.value -> ?args:As_args.t -> 51 | ?spec:spec -> ?install:bool -> kind -> 52 | [< `Base | `Bin | `Dir | `Doc | `Lib | `Unit ] As_part.t list -> 53 | [> `Dir ] As_part.t 54 | -------------------------------------------------------------------------------- /lib/as_part_doc.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | open Bos 19 | 20 | (* Metadata *) 21 | 22 | type kind = [ `OCamldoc ] 23 | 24 | let pp_kind ppf k = Fmt.string ppf begin match k with 25 | | `OCamldoc -> "ocamldoc" 26 | end 27 | 28 | type meta = { kind : kind } 29 | 30 | let inj, proj = As_part.meta_key () 31 | let get_meta p = As_part.get_meta proj p 32 | let meta kind = inj { kind } 33 | let kind p = (get_meta p).kind 34 | 35 | let is_kind k p = match As_part.coerce_if `Doc p with 36 | | None -> None 37 | | Some p as r -> if kind p = k then r else None 38 | 39 | let ocamldoc p = is_kind `OCamldoc p 40 | 41 | (* Unit filters *) 42 | 43 | let default p = match As_part_unit.kind p with 44 | | `OCaml (_, `Hidden) -> false 45 | | `OCaml _ -> true 46 | | _ -> false 47 | 48 | let dev p = match As_part_unit.kind p with `OCaml _ -> true | _ -> false 49 | 50 | (* Check *) 51 | 52 | let check p = 53 | let doc = As_part.coerce `Doc p in 54 | Log.warn "%a part check is TODO" As_part.pp_kind (As_part.kind doc); 55 | As_conf.true_ 56 | 57 | (* Actions *) 58 | 59 | let actions p = 60 | let doc = As_part.coerce `Doc p in 61 | Log.warn "%a part actions are TODO" As_part.pp_kind (As_part.kind doc); 62 | As_conf.const [] 63 | 64 | (* Doc *) 65 | 66 | let v ?usage ?exists ?args ?keep name kind needs = 67 | let _keep = match keep with 68 | | Some k -> k 69 | | None -> if usage = Some `Dev then dev else default 70 | in 71 | let meta = meta kind in 72 | As_part.v_kind ?usage ?exists ?args ~meta ~needs ~actions ~check name `Doc 73 | -------------------------------------------------------------------------------- /lib/as_part_doc.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | (** API documentation part. 19 | 20 | See {!Assemblage.Doc}. *) 21 | 22 | (** {1 Metadata} *) 23 | 24 | type kind = [ `OCamldoc ] 25 | 26 | val pp_kind : Format.formatter -> kind -> unit 27 | 28 | val kind : [< `Doc] As_part.t -> [`OCamldoc ] 29 | val ocamldoc : 'a As_part.t -> [> `Doc ] As_part.t option 30 | 31 | (** {1 Unit filters} *) 32 | 33 | val default : [< `Unit] As_part.t -> bool 34 | val dev : [< `Unit] As_part.t -> bool 35 | 36 | (** {1 Doc} *) 37 | 38 | val v : ?usage:As_part.usage -> ?exists:bool As_conf.value -> 39 | ?args:As_args.t -> ?keep:([< `Unit] As_part.t -> bool) -> 40 | string -> kind -> [< `Lib | `Unit | `Bin | `Pkg ] As_part.t list -> 41 | [> `Doc] As_part.t 42 | -------------------------------------------------------------------------------- /lib/as_part_lib.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | open Bos 19 | 20 | (* Metadata *) 21 | 22 | type kind = [ `OCaml | `OCaml_pp | `C ] 23 | 24 | let pp_kind ppf k = Fmt.string ppf begin match k with 25 | | `OCaml -> "OCaml" | `OCaml_pp -> "OCaml_pp" | `C -> "C" 26 | end 27 | 28 | type meta = { kind : kind; byte : bool; native : bool; native_dynlink : bool; } 29 | 30 | let inj, proj = As_part.meta_key () 31 | let get_meta p = As_part.get_meta proj p 32 | let meta ?byte ?native ?native_dynlink kind = 33 | let def_byte, def_nat, def_nat_dynlink = match kind with 34 | | `OCaml -> true, true, true 35 | | `OCaml_pp -> true, false, false 36 | | `C -> false, true, true 37 | in 38 | let byte = match byte with None -> def_byte | Some b -> b in 39 | let native = match native with None -> def_nat | Some b -> b in 40 | let native_dynlink = match native_dynlink with 41 | | None -> def_nat_dynlink | Some b -> b 42 | in 43 | inj { kind; byte; native; native_dynlink } 44 | 45 | let kind p = (get_meta p).kind 46 | let byte p = (get_meta p).byte 47 | let native p = (get_meta p).native 48 | let native_dynlink p = (get_meta p).native_dynlink 49 | 50 | let is_kind k p = match As_part.coerce_if `Lib p with 51 | | None -> None 52 | | Some p as r -> if kind p = k then r else None 53 | 54 | let ocaml = is_kind `OCaml 55 | let ocaml_pp = is_kind `OCaml_pp 56 | let c = is_kind `C 57 | 58 | let warn_unit_dupe = format_of_string 59 | "More@ than@ one@ unit@ named@ `%s'@ in@ library@ part@ %s" 60 | 61 | let find_unit u p = 62 | let is_u part = match As_part.coerce_if `Unit part with 63 | | Some part when As_part.name part = u -> Some part 64 | | _ -> None 65 | in 66 | match As_part.list_keep_map is_u (As_part.needs p) with 67 | | [] -> None 68 | | [u] -> Some u 69 | | us -> Log.warn warn_unit_dupe u (As_part.name p); Some (List.hd us) 70 | 71 | (* Checks *) 72 | 73 | let check p = 74 | let lib = As_part.coerce `Lib p in 75 | Log.warn "%a part check is TODO" As_part.pp_kind (As_part.kind lib); 76 | As_conf.true_ 77 | 78 | (* Actions *) 79 | 80 | (* FIXME here we should add rules for ocamldep for each unit. And 81 | add the dep as an input to its actions. *) 82 | 83 | let c_actions lib dst_dir unit_actions = 84 | Log.warn "C library part support is TODO"; 85 | As_conf.const [] 86 | 87 | let ocaml_actions kind lib dst_dir unit_actions = 88 | let actions ocamlc ocamlopt debug ocaml_byte ocaml_native ocaml_native_dynlink 89 | dst_dir unit_actions = 90 | let open As_acmd.Args in 91 | let not_pp = kind <> `OCaml_pp in 92 | let name = Path.(dst_dir / As_part.name lib) in 93 | let unit_outputs = As_action.list_outputs unit_actions in 94 | let cmos = List.rev (List.filter (Path.ext_is ".cmo") unit_outputs) in 95 | let cmx_s = List.rev (List.filter (Path.ext_is ".cmx") unit_outputs) in 96 | let byte = byte lib && ocaml_byte in 97 | let native = native lib && ocaml_native && not_pp in 98 | let shared = native_dynlink lib && ocaml_native_dynlink && not_pp in 99 | let args = add_if debug "-g" @@ [] in 100 | fadd_if byte 101 | (As_action_ocaml.archive_byte ~args ~ocamlc ~cmos ~name) () @@ 102 | fadd_if native 103 | (As_action_ocaml.archive_native ~args ~ocamlopt ~cmx_s ~name) () @@ 104 | fadd_if shared 105 | (As_action_ocaml.archive_shared ~args ~ocamlopt ~cmx_s ~name) () @@ 106 | unit_actions 107 | in 108 | As_conf.(const actions $ As_acmd.cmd ocamlc $ As_acmd.cmd ocamlopt $ 109 | value debug $ value ocaml_byte $ value ocaml_native $ 110 | value ocaml_native_dynlink $ dst_dir $ unit_actions) 111 | 112 | let integrated_unit_actions lib = (* integrated actions of lib's `Unit needs *) 113 | let integrate acc p = match As_part.coerce_if `Unit p with 114 | | None -> acc 115 | | Some u -> 116 | let add_need n = As_part.(kind n = `Pkg || kind n = `Lib) in 117 | As_part.integrate ~add_need u lib :: acc 118 | in 119 | As_part.list_actions (List.fold_left integrate [] (As_part.needs lib)) 120 | 121 | let actions p = 122 | let lib = As_part.coerce `Lib p in 123 | let dst_dir = As_part.root_path lib in 124 | let unit_actions = integrated_unit_actions lib in 125 | match kind p with 126 | | `OCaml | `OCaml_pp as k -> ocaml_actions k lib dst_dir unit_actions 127 | | `C -> c_actions lib dst_dir unit_actions 128 | 129 | (* Lib *) 130 | 131 | let v ?usage ?exists ?args ?byte ?native ?native_dynlink name kind needs = 132 | let meta = meta ?byte ?native ?native_dynlink kind in 133 | As_part.v_kind ?usage ?exists ?args ~meta ~needs ~actions ~check name `Lib 134 | -------------------------------------------------------------------------------- /lib/as_part_lib.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | (** Library part. 19 | 20 | See {!Assemblage.Lib}. *) 21 | 22 | (** {1 Metadata} *) 23 | 24 | type kind = [ `OCaml | `OCaml_pp | `C ] 25 | val pp_kind : Format.formatter -> kind -> unit 26 | val kind : [< `Lib] As_part.t -> kind 27 | val byte : [< `Lib] As_part.t -> bool 28 | val native : [< `Lib] As_part.t -> bool 29 | val native_dynlink : [< `Lib] As_part.t -> bool 30 | val ocaml : 'a As_part.t -> [> `Lib] As_part.t option 31 | val ocaml_pp : 'a As_part.t -> [> `Lib] As_part.t option 32 | val c : 'a As_part.t -> [> `Lib] As_part.t option 33 | 34 | val find_unit : string -> 'a As_part.t -> [> `Unit] As_part.t option 35 | 36 | (** {1 Lib} *) 37 | 38 | val v : 39 | ?usage:As_part.usage -> 40 | ?exists:bool As_conf.value -> 41 | ?args:As_args.t -> 42 | ?byte:bool -> ?native:bool -> ?native_dynlink:bool -> 43 | string -> kind -> [< `Unit | `Pkg | `Lib] As_part.t list -> 44 | [> `Lib] As_part.t 45 | -------------------------------------------------------------------------------- /lib/as_part_pkg.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | open Astring 19 | open Bos 20 | 21 | (* Metadata *) 22 | 23 | type lookup = As_ctx.t -> string list 24 | type kind = 25 | [ `OCamlfind 26 | | `Pkg_config 27 | | `Other of string * lookup As_conf.value ] 28 | 29 | let pp_kind ppf = function 30 | | `OCamlfind -> Fmt.string ppf "ocamlfind" 31 | | `Pkg_config -> Fmt.string ppf "pkg-config" 32 | | `Other (n, _) -> Fmt.pf ppf "%s" n 33 | 34 | type meta = { kind : kind; lookup : lookup As_conf.value; opt : bool } 35 | 36 | let inj, proj = As_part.meta_key () 37 | let get_meta p = As_part.get_meta proj p 38 | let meta ?(opt = false) kind lookup = inj { kind; lookup; opt } 39 | 40 | let kind p = (get_meta p).kind 41 | let lookup p = (get_meta p).lookup 42 | let opt p = (get_meta p).opt 43 | 44 | let is_kind k p = match As_part.coerce_if `Pkg p with 45 | | None -> None 46 | | Some p as r -> 47 | match kind p with 48 | | `OCamlfind when k = `OCamlfind -> r 49 | | `Pkg_config when k = `Pkg_config -> r 50 | | `Other _ when k = `Other -> r 51 | | _ -> None 52 | 53 | let ocamlfind = is_kind `OCamlfind 54 | let pkg_config = is_kind `Pkg_config 55 | let other = is_kind `Other 56 | 57 | (* Checks *) 58 | 59 | let check p = 60 | let pkg = As_part.coerce `Pkg p in 61 | Log.warn "%a part check is TODO" As_part.pp_kind (As_part.kind pkg); 62 | As_conf.true_ 63 | 64 | (* Packages *) 65 | 66 | let lookup_value name = function 67 | | `OCamlfind -> As_ocamlfind.lookup name 68 | | `Pkg_config -> As_pkg_config.lookup name 69 | | `Other (_, lookup) -> lookup 70 | 71 | let v ?usage ?exists ?opt name kind = 72 | let lookup = lookup_value name kind in 73 | let meta = meta ?opt kind lookup in 74 | As_part.v_kind ?usage ?exists ~meta ~check name `Pkg 75 | 76 | (* FIXME the following wont work if two packages depend 77 | on the same package we will get double linking. What 78 | strategy for uniq ? *) 79 | let list_lookup ps = 80 | let add_pkg acc p = match As_part.coerce_if `Pkg p with 81 | | None -> acc 82 | | Some pkg -> 83 | let lookup = lookup p in 84 | let combine lookup acc ctx = 85 | List.rev_append (List.rev (lookup ctx)) (acc ctx) 86 | in 87 | As_conf.(const combine $ lookup $ acc) 88 | in 89 | List.fold_left add_pkg (As_conf.const (fun _ -> [])) (List.rev ps) 90 | -------------------------------------------------------------------------------- /lib/as_part_pkg.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | (** Package part. 19 | 20 | See {!Assemblage.Pkg} *) 21 | 22 | (** {1 Metadata} *) 23 | 24 | type lookup = As_ctx.t -> string list 25 | type kind = 26 | [ `OCamlfind 27 | | `Pkg_config 28 | | `Other of string * lookup As_conf.value ] 29 | 30 | val pp_kind : Format.formatter -> kind -> unit 31 | val kind : [< `Pkg] As_part.t -> kind 32 | val lookup : [< `Pkg] As_part.t -> lookup As_conf.value 33 | val opt : [< `Pkg] As_part.t -> bool 34 | val ocamlfind : 'a As_part.t -> [> `Pkg] As_part.t option 35 | val pkg_config : 'a As_part.t -> [> `Pkg] As_part.t option 36 | val other : 'a As_part.t -> [> `Pkg] As_part.t option 37 | 38 | (** {1 Packages} *) 39 | 40 | val v : 41 | ?usage:As_part.usage -> ?exists:bool As_conf.value -> ?opt:bool -> 42 | string -> kind -> [> `Pkg] As_part.t 43 | 44 | val list_lookup : 'a As_part.t list -> lookup As_conf.value 45 | -------------------------------------------------------------------------------- /lib/as_part_run.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | open Bos 19 | 20 | (* Checks *) 21 | 22 | let check p = 23 | let run = As_part.coerce `Run p in 24 | Log.warn "%a part check is TODO" As_part.pp_kind (As_part.kind run); 25 | As_conf.true_ 26 | 27 | (* Actions *) 28 | 29 | let actions ?dir action _ = 30 | let actions action cd dir = match dir with 31 | | None -> [ action ] 32 | | Some dir -> [ As_action.add_cmds `Before [ cd dir ] action ] 33 | in 34 | As_conf.(const actions $ action $ As_acmd.cd $ Option.wrap dir) 35 | 36 | (* Run *) 37 | 38 | let v ?usage ?exists ?args ?dir name action = 39 | let actions = actions ?dir action in 40 | As_part.v_kind ?usage ?exists ?args ~actions ~check name `Run 41 | 42 | let with_bin ?usage ?exists ?args ?dir ?name ?ext bin cmds = 43 | let name = match name with None -> As_part.name bin | Some n -> n in 44 | let exists = match exists with 45 | | None -> As_part_bin.exists ?ext bin 46 | | Some exists -> As_conf.(exists &&& As_part_bin.exists ?ext bin) 47 | in 48 | let action path bin cmds = As_action.v ~inputs:[ path ] (cmds bin) in 49 | let cpath = As_part_bin.to_cmd_path ?ext bin in 50 | let bin = As_part_bin.to_cmd ?ext bin in 51 | v ?usage ~exists ?args ?dir name As_conf.(const action $ cpath $ bin $ cmds) 52 | 53 | let bin ?usage ?exists ?args ?dir ?name ?ext ?stdin ?stdout ?stderr bin cargs = 54 | let cmds stdin stdout stderr cargs bin = 55 | [ As_acmd.v bin cargs ?stdin ?stdout ?stderr ] 56 | in 57 | let cmds = 58 | As_conf.(const cmds $ Option.wrap stdin $ Option.wrap stdout $ 59 | Option.wrap stderr $ cargs) 60 | in 61 | with_bin ?usage ?exists ?args ?dir ?name ?ext bin cmds 62 | -------------------------------------------------------------------------------- /lib/as_part_run.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | (** Run part. 19 | 20 | See {!Assemblage.Run}. *) 21 | 22 | open Bos 23 | 24 | (** {1 Run} *) 25 | 26 | val v : ?usage:As_part.usage -> ?exists:bool As_conf.value -> 27 | ?args:As_args.t -> ?dir:path As_conf.value -> 28 | string -> As_action.t As_conf.value -> [> `Run] As_part.t 29 | 30 | val with_bin : ?usage:As_part.usage -> ?exists:bool As_conf.value -> 31 | ?args:As_args.t -> ?dir:path As_conf.value -> ?name:string -> 32 | ?ext:Path.ext -> [< `Bin] As_part.t -> 33 | (As_acmd.cmd -> As_acmd.t list) As_conf.value -> [> `Run] As_part.t 34 | 35 | val bin : ?usage:As_part.usage -> ?exists:bool As_conf.value -> 36 | ?args:As_args.t -> ?dir:path As_conf.value -> ?name:string -> 37 | ?ext:Path.ext -> ?stdin:path As_conf.value -> 38 | ?stdout:path As_conf.value -> ?stderr:path As_conf.value -> 39 | [< `Bin] As_part.t -> string list As_conf.value -> [> `Run] As_part.t 40 | -------------------------------------------------------------------------------- /lib/as_part_unit.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | (** Compilation unit part. 19 | 20 | See {!Assemblage.Unit}. *) 21 | 22 | open Bos 23 | 24 | (** {1 Metadata} *) 25 | 26 | type ocaml_interface = [ `Normal | `Opaque | `Hidden ] 27 | type ocaml_unit = [ `Ml | `Mli | `Both ] 28 | type c_unit = [ `C | `H | `Both ] 29 | 30 | type kind = [ `OCaml of ocaml_unit * ocaml_interface | `C of c_unit | `Js ] 31 | val pp_kind : Format.formatter -> kind -> unit 32 | 33 | val kind : [< `Unit] As_part.t -> kind 34 | val dir : [< `Unit] As_part.t -> path As_conf.value 35 | 36 | val ocaml : 'a As_part.t -> [> `Unit] As_part.t option 37 | val c : 'a As_part.t -> [> `Unit] As_part.t option 38 | val js : 'a As_part.t -> [> `Unit] As_part.t option 39 | 40 | (** {1 Unit} *) 41 | 42 | val v : ?usage:As_part.usage -> ?exists:bool As_conf.value -> 43 | ?args:As_args.t -> ?needs:[< `Pkg | `Lib ] As_part.t list -> 44 | ?dir:path As_conf.value -> string -> kind -> [> `Unit] As_part.t 45 | -------------------------------------------------------------------------------- /lib/as_pkg_config.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Daniel C. Bünzli 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | open Astring 18 | open Bos 19 | 20 | type syntax = [ `Shell | `Makefile ] 21 | type mode = [ `Static | `Dynamic of [`Shell | `Makefile] ] 22 | 23 | let query_args ?wrap ~opts pkgs = 24 | (* FIXME support wrap *) 25 | "pkg-config", opts @ pkgs 26 | 27 | let query_static = 28 | let cache = Hashtbl.create 124 in 29 | let run (cmd, args as l) = try Hashtbl.find cache l with 30 | | Not_found -> 31 | let r = Log.on_error_msg ~use:[] @@ OS.Cmd.exec_read_lines cmd args in 32 | Hashtbl.add cache l r; 33 | r 34 | in 35 | fun ?wrap ~opts pkgs -> 36 | let cmd = query_args ?wrap ~opts pkgs in 37 | run cmd 38 | 39 | let query_makefile ?wrap ~opts pkgs = 40 | let cmd, args = query_args ?wrap ~opts pkgs in 41 | [ strf "$(shell %s %s)" cmd (String.concat ~sep:" " args) ] 42 | 43 | let query ~mode = match mode with 44 | | `Static -> query_static 45 | | `Dynamic `Shell -> 46 | fun ?wrap ~opts pkgs -> 47 | let (cmd, args) = query_args ?wrap ~opts pkgs in 48 | [String.concat ~sep:" " (cmd :: args)] 49 | | `Dynamic `Makefile -> query_makefile 50 | 51 | let cflags ?wrap ~mode pkgs = query ~mode ?wrap ~opts:["--cflags"] pkgs 52 | let cflags_I ?wrap ~mode pkgs = query ~mode ?wrap ~opts:["--cflags-only-I"] pkgs 53 | let cflags_other ?wrap ~mode pkgs = 54 | query ~mode ?wrap ~opts:["--cflags-only-other"] pkgs 55 | 56 | let libs ?wrap ~mode pkgs = query ~mode ?wrap ~opts:["--libs"] pkgs 57 | let libs_l ?wrap ~mode pkgs = query ~mode ?wrap ~opts:["-libs-only-l"] pkgs 58 | let libs_L ?wrap ~mode pkgs = query ~mode ?wrap ~opts:["-libs-only-L"] pkgs 59 | let libs_other ?wrap ~mode pkgs = 60 | query ~mode ?wrap ~opts:["-libs-only-other"] pkgs 61 | 62 | 63 | let pkgs_args ~mode = function 64 | | [] -> As_args.empty 65 | | pkgs -> As_args.empty 66 | (* 67 | let ocaml_clink_flags = 68 | (libs_l ~wrap:"-cclib" ~mode pkgs) @ 69 | (libs_L ~wrap:"-ccopt" ~mode pkgs) @ 70 | (libs_other ~wrap:"-ccopt" ~mode pkgs) 71 | in 72 | let ocamlmklib_flags = 73 | (libs_l ~mode pkgs) @ 74 | (libs_L ~mode pkgs) @ 75 | (libs_other ~wrap:"-ldopt" ~mode pkgs) 76 | in 77 | Args.concat [ 78 | Args.v (Ctx.v [`C; `Pp]) (cflags ~mode pkgs); 79 | Args.v (`Compile `C) (cflags ~wrap:"-ccopt" ~mode pkgs); 80 | Args.v (`Link `C) (ocaml_clink_flags); 81 | Args.v (`Archive `C) (ocamlmklib_flags); 82 | Args.v (`Archive `C_shared) (ocamlmklib_flags); 83 | Args.v (`Link `Byte) (ocaml_clink_flags); 84 | Args.v (`Link `Native) (ocaml_clink_flags); 85 | Args.v (`Archive `Byte) (ocaml_clink_flags); 86 | Args.v (`Archive `Native) (ocaml_clink_flags); 87 | Args.v (`Archive `Shared) (ocaml_clink_flags); ] 88 | *) 89 | 90 | let lookup name = (* TODO, copycat on As_ocamlfind *) 91 | As_conf.(const (fun ctx -> [])) 92 | -------------------------------------------------------------------------------- /lib/as_pkg_config.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Daniel C. Bünzli 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | (** pkg-config lookup. *) 18 | 19 | val lookup : string -> (As_ctx.t -> string list) As_conf.value 20 | -------------------------------------------------------------------------------- /lib/as_project.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | open Astring 19 | open Bos 20 | 21 | (* Project *) 22 | 23 | type t = 24 | { name : string; (* The name of the project. *) 25 | exists : bool As_conf.value; (* [true] if exists in config. *) 26 | args : As_args.t; (* argument bundle appended to all actions. *) 27 | schemes : As_conf.scheme list; (* user-defined configuration schemes. *) 28 | parts : As_part.kind As_part.t list;(* project's toplevel parts, unique. *) 29 | deps : As_conf.Key.Set.t Lazy.t; (* config key deps (derived). *) 30 | conf : As_conf.t option; } (* configuration to use, set by driver. *) 31 | 32 | let deps p = 33 | let add_part acc p = As_conf.Key.Set.union acc (As_part.deps p) in 34 | let add_key k acc = As_conf.Key.(Set.add (hide_type k) acc) in 35 | List.fold_left add_part As_conf.Key.Set.empty p.parts 36 | |> add_key As_conf.project_version 37 | |> add_key As_conf.root_dir 38 | 39 | let v ?(exists = As_conf.true_) ?(args = As_args.empty) ?(schemes = []) name 40 | ~parts = 41 | let parts = As_part.list_uniquify (parts :> As_part.kind As_part.t list) in 42 | let rec p = 43 | { name; exists; args; schemes; parts; deps = lazy (deps p); conf = None; } 44 | in 45 | p 46 | 47 | let name p = p.name 48 | let exists p = p.exists 49 | let args p = p.args 50 | let schemes p = p.schemes 51 | let parts p = p.parts 52 | let deps p = Lazy.force p.deps 53 | 54 | (* Configuration and evaluation *) 55 | 56 | let warn_no_config = format_of_string 57 | "No@ configuration@ set@ for@ project,@ using@ base@ configuration." 58 | 59 | let conf p = match p.conf with 60 | | Some c -> c 61 | | None -> 62 | As_misc.log_driver_fault Log.Warning warn_no_config; 63 | As_conf.of_keys (deps p) 64 | 65 | let with_conf old c = { old with conf = Some c; } 66 | let eval p v = As_conf.eval (conf p) v 67 | let eval_key p k = eval p (As_conf.value k) 68 | 69 | (* Configuration dependent values *) 70 | 71 | let version p = eval_key p As_conf.project_version 72 | 73 | let products ?(kind = `Any) proj = 74 | let add_path acc p = Path.Set.add p acc in 75 | let add_part acc part = 76 | let add_action (i, o) act = 77 | List.fold_left add_path i (As_action.inputs act), 78 | List.fold_left add_path o (As_action.outputs act) 79 | in 80 | List.fold_left add_action acc (eval proj (As_part.actions part)) 81 | in 82 | let init = Path.Set.empty, Path.Set.empty in 83 | let i, o = As_part.list_fold add_part init (parts proj) in 84 | match kind with 85 | | `Any -> Path.Set.union i o 86 | | `Source -> Path.Set.diff i o 87 | | `Input -> i 88 | | `Output -> o 89 | 90 | let watermark_string ?suffix p = 91 | let suffix = match suffix with 92 | | None -> "-- generated by assemblage %%VERSION%%" 93 | | Some s -> s 94 | in 95 | strf "%s %s %s" (name p) (version p) suffix 96 | 97 | let pp_signature ppf p = 98 | let pp_icon = (* UTF-8 *) 99 | let pp_icon ppf () = Fmt.pf ppf " \xF0\x9F\x8D\xB7" in 100 | Fmt.(if_utf_8 pp_icon nop) 101 | in 102 | Fmt.(pf ppf "%a %s%a" 103 | (styled_string `Bold) (name p) (version p) pp_icon ()) 104 | 105 | (* Assembling projects *) 106 | 107 | let projects = ref [] 108 | let assemble p = projects := p :: !projects 109 | let list () = List.rev !projects 110 | -------------------------------------------------------------------------------- /lib/as_project.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | (** Project. 19 | 20 | For documentation see {!Assemblage.Private.Project}. *) 21 | 22 | (** {1 Project} *) 23 | 24 | open Bos 25 | 26 | type t 27 | 28 | val v : ?exists:bool As_conf.value -> ?args:As_args.t -> 29 | ?schemes:As_conf.scheme list -> string -> parts:'a As_part.t list -> t 30 | 31 | val name : t -> string 32 | val exists : t -> bool As_conf.value 33 | val args : t -> As_args.t 34 | val schemes : t -> As_conf.scheme list 35 | val parts : t -> As_part.kind As_part.t list 36 | 37 | (** {1 Configuration} *) 38 | 39 | val deps : t -> As_conf.Key.Set.t 40 | val conf : t -> As_conf.t 41 | val with_conf : t -> As_conf.t -> t 42 | 43 | val eval : t -> 'a As_conf.value -> 'a 44 | val eval_key : t -> 'a As_conf.key -> 'a 45 | 46 | (** {1 Configuration dependent value} *) 47 | 48 | val version : t -> string 49 | val products : ?kind:[`Source | `Input | `Output | `Any ] -> t -> Path.Set.t 50 | val watermark_string : ?suffix:string -> t -> string 51 | val pp_signature : Format.formatter -> t -> unit 52 | 53 | (** {1 Assembling projects} *) 54 | 55 | val assemble : t -> unit 56 | val list : unit -> t list 57 | -------------------------------------------------------------------------------- /lib/as_univ.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Daniel C. Bünzli 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | type t = exn 18 | 19 | let create (type s) () = 20 | let module M = struct exception E of s option end in 21 | (fun x -> M.E (Some x)), (function M.E x -> x | _ -> None) 22 | -------------------------------------------------------------------------------- /lib/as_univ.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Daniel C. Bünzli 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | 18 | (** Universal values. 19 | 20 | See http://mlton.org/UniversalType *) 21 | 22 | (** {1 Universal values} *) 23 | 24 | type t 25 | (** The type for universal values. *) 26 | 27 | val create : unit -> (('a -> t) * (t -> 'a option)) 28 | (** [create ()] returns a function to inject and a function to project a 29 | value from a given type in to/from a universal value. *) 30 | -------------------------------------------------------------------------------- /lib/as_vcs.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2015 Daniel C. Bünzli 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | open Astring 18 | open Rresult 19 | open Bos 20 | 21 | type t = [ `Git | `Hg ] 22 | 23 | let dirtify id = id ^ "-dirty" 24 | 25 | (* VCS detection and executable override *) 26 | 27 | let override_kind = ref None 28 | let override_exec = ref None 29 | let set_override_kind v = override_kind := v 30 | let set_override_exec exec = override_exec := exec 31 | let override_kind () = !override_kind 32 | let override_exec () = !override_exec 33 | 34 | (* Git *) 35 | 36 | let git_dir = ".git" 37 | let git_exists root_dir = match override_kind () with 38 | | Some `Git -> Ok true 39 | | Some _ | None -> OS.Dir.exists Path.(root_dir / git_dir) 40 | 41 | let git root_dir args = 42 | let git = match override_exec () with 43 | | Some exec when override_kind () = Some `Git -> exec 44 | | _ -> "git" 45 | in 46 | let dir = Path.(to_string (root_dir / git_dir)) in 47 | OS.Cmd.exec_read git ("--git-dir" :: dir :: args) 48 | 49 | let git_head mark_dirty root_dir = 50 | git root_dir [ "show-ref"; "HEAD"; "--hash" ] >>= fun hash -> 51 | if not mark_dirty then Ok hash else 52 | git root_dir [ "status"; "--porcelain" ] >>= function 53 | | "" -> Ok hash 54 | | _ -> Ok (dirtify hash) 55 | 56 | let git_describe mark_dirty root_dir = 57 | let opt = if mark_dirty then [ "--dirty" ] else [] in 58 | git root_dir ([ "describe"; "--always"; ] @ opt) 59 | 60 | (* Hg *) 61 | 62 | let hg_dir = ".hg" 63 | let hg_exists root_dir = match override_kind () with 64 | | Some `Hg -> Ok true 65 | | Some _ | None -> OS.Dir.exists Path.(root_dir / hg_dir) 66 | 67 | let hg root_dir args = 68 | let hg = match override_exec () with 69 | | Some exec when override_kind () = Some `Hg -> exec 70 | | _ -> "hg" 71 | in 72 | OS.Cmd.exec_read hg ("--repository" :: Path.to_string root_dir :: args) 73 | 74 | let hg_id root_dir = 75 | hg root_dir [ "id"; "-i" ] >>= fun id -> 76 | let is_dirty = String.length id > 0 && id.[String.length id - 1] = '+' in 77 | let id = if is_dirty then String.slice ~stop:(-1) id else id in 78 | Ok (id, is_dirty) 79 | 80 | let hg_head mark_dirty root_dir = 81 | hg_id root_dir >>= fun (id, is_dirty) -> 82 | Ok (if is_dirty && mark_dirty then dirtify id else id) 83 | 84 | let hg_describe mark_dirty root_dir = 85 | let get_distance s = try Ok (int_of_string s) with 86 | | Failure _ -> R.error_msg "could not parse hg tag distance" 87 | in 88 | let hg_parent template = hg root_dir [ "parent"; "--template"; template ] in 89 | hg_parent "\"{latesttagdistance}\"" >>= get_distance 90 | >>= begin function 91 | | 1 -> hg_parent "\"{latesttag}\"" 92 | | n -> hg_parent "\"{latesttag}-{latesttagdistance}-{node|short}\"" 93 | end 94 | >>= fun descr -> 95 | if not mark_dirty then Ok descr else 96 | hg_id root_dir >>= fun (_, is_dirty) -> 97 | Ok (if is_dirty then dirtify descr else descr) 98 | 99 | (* VCS detection *) 100 | 101 | let exists root_dir = function 102 | | `Git -> git_exists root_dir 103 | | `Hg -> hg_exists root_dir 104 | 105 | let find root_dir = match override_kind () with 106 | | Some kind -> Ok (Some kind) 107 | | None -> 108 | git_exists root_dir >>= function 109 | | true -> Ok (Some `Git) 110 | | false -> 111 | hg_exists root_dir >>= function 112 | | true -> Ok (Some `Hg) 113 | | false -> Ok None 114 | 115 | let get root_dir = 116 | find root_dir >>= function 117 | | Some vcs -> Ok vcs 118 | | None -> R.error_msg "No VCS found" 119 | 120 | (* VCS commands *) 121 | 122 | let head ?(dirty = true) root_dir = function 123 | | `Git -> git_head dirty root_dir 124 | | `Hg -> hg_head dirty root_dir 125 | 126 | let describe ?(dirty = true) root_dir = function 127 | | `Git -> git_describe dirty root_dir 128 | | `Hg -> hg_describe dirty root_dir 129 | -------------------------------------------------------------------------------- /lib/as_vcs.mli: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2015 Daniel C. Bünzli 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | open Bos 18 | 19 | type t = [ `Git | `Hg ] 20 | 21 | val override_kind : unit -> t option 22 | val set_override_kind : t option -> unit 23 | val override_exec : unit -> string option 24 | val set_override_exec : string option -> unit 25 | 26 | val exists : path -> t -> bool Bos.OS.result 27 | val find : path -> t option Bos.OS.result 28 | val get : path -> t Bos.OS.result 29 | val head : ?dirty:bool -> path -> t -> string Bos.OS.result 30 | val describe : ?dirty:bool -> path -> t -> string Bos.OS.result 31 | -------------------------------------------------------------------------------- /lib/assemblage.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Thomas Gazagnaire 3 | * Copyright (c) 2014 Daniel C. Bünzli 4 | * 5 | * Permission to use, copy, modify, and distribute this software for any 6 | * purpose with or without fee is hereby granted, provided that the above 7 | * copyright notice and this permission notice appear in all copies. 8 | * 9 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 | *) 17 | 18 | (* Pereliminaries *) 19 | 20 | include Rresult 21 | include Astring 22 | include Bos 23 | 24 | module Fmt = Fmt 25 | module Vcs = As_vcs 26 | 27 | (* Building *) 28 | 29 | module Conf = As_conf 30 | module Ctx = As_ctx 31 | module Args = As_args 32 | module Acmd = As_acmd 33 | module Action = As_action 34 | 35 | (* Parts *) 36 | 37 | module Part = As_part 38 | module Unit = As_part_unit 39 | module Lib = As_part_lib 40 | module Bin = As_part_bin 41 | module Pkg = As_part_pkg 42 | module Doc = As_part_doc 43 | module Dir = As_part_dir 44 | module Run = As_part_run 45 | 46 | type part_kind = As_part.kind 47 | type +'a part = 'a As_part.t 48 | 49 | (* Part specification combinators *) 50 | 51 | type cpath = Path.t Conf.value 52 | 53 | let root = Conf.(const Path.cur_dir) 54 | let ( / ) p seg = Conf.(const Path.add_seg $ p $ const seg) 55 | let ( // ) p rel = Conf.(const Path.append $ p $ rel) 56 | 57 | let unit ?usage ?exists ?args ?needs ?(kind = `OCaml (`Both, `Normal)) 58 | ?dir name = 59 | Unit.v ?usage ?exists ?args ?needs ?dir name kind 60 | 61 | let lib ?usage ?exists ?args ?byte ?native ?native_dynlink ?(kind = `OCaml) 62 | name needs = 63 | Lib.v ?usage ?exists ?args ?byte ?native ?native_dynlink name kind needs 64 | 65 | let bin ?usage ?exists ?args ?byte ?native ?js ?(kind = `OCaml) name needs = 66 | Bin.v ?usage ?exists ?args ?byte ?native ?js name kind needs 67 | 68 | let pkg ?usage ?exists ?opt ?(kind = `OCamlfind) name = 69 | Pkg.v ?usage ?exists ?opt name kind 70 | 71 | let doc ?usage ?exists ?args ?keep ?(kind = `OCamldoc) name needs = 72 | Doc.v ?usage ?exists ?args ?keep name kind needs 73 | 74 | let dir ?usage ?exists ?args ?spec ?install kind needs = 75 | Dir.v ?usage ?exists ?args ?spec ?install kind needs 76 | 77 | let file ?usage ?exists p = 78 | Part.file ?usage ?exists p 79 | 80 | let run ?usage ?exists ?args ?dir name action = 81 | Run.v ?usage ?exists ?args ?dir name action 82 | 83 | (* Projects *) 84 | 85 | module Project = As_project 86 | type project = Project.t 87 | let assemble = Project.assemble 88 | 89 | (* Private API *) 90 | 91 | module Private = struct 92 | 93 | module Misc = As_misc 94 | module Vcs = As_vcs 95 | module Conf = As_conf 96 | module Args = As_args 97 | module Acmd = struct 98 | type args = Args.t 99 | include Acmd 100 | end 101 | module Action = As_action 102 | module Part = As_part 103 | module Project = As_project 104 | end 105 | -------------------------------------------------------------------------------- /opam: -------------------------------------------------------------------------------- 1 | opam-version: "1.2" 2 | maintainer: "thomas@gazagnaire.org" 3 | authors: [ 4 | "Thomas Gazagnaire " 5 | "Daniel Bünzli " 6 | ] 7 | homepage: "https://github.com/samoht/assemblage/" 8 | doc: "http://samoht.github.io/assemblage/Assemblage.html" 9 | dev-repo: "https://github.com/samoht/assemblage.git" 10 | bug-reports: "https://github.com/samoht/assemblage/issues" 11 | tags: ["build system"] 12 | license: "ISC" 13 | depends: [ 14 | "ocamlfind" 15 | "rresult" 16 | "astring" 17 | "fmt" 18 | "bos" 19 | "cmdliner" {>= "0.9.6"} 20 | "dumpast" 21 | "sexplib" {test} 22 | "comparelib" {test} 23 | "xmlm" {test} 24 | "ezjsonm" {test} 25 | "ctypes" {test} 26 | ] 27 | build-test: [make "test"] 28 | build: [ 29 | ["./bootstrap.sh"] 30 | [make] 31 | ] 32 | -------------------------------------------------------------------------------- /test/builtin-keys/test.ml: -------------------------------------------------------------------------------- 1 | (* 2 | * Copyright (c) 2014 Daniel C. Bünzli 3 | * 4 | * Permission to use, copy, modify, and distribute this software for any 5 | * purpose with or without fee is hereby granted, provided that the above 6 | * copyright notice and this permission notice appear in all copies. 7 | * 8 | * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 9 | * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 10 | * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 11 | * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 12 | * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 13 | * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 14 | * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 15 | *) 16 | 17 | (* Uses all the builtin keys so that we can check their documentation, 18 | defaults and parsing. *) 19 | 20 | open Assemblage 21 | open Assemblage.Private 22 | open Assemblage_driver 23 | 24 | let test_keys = 25 | let add_key k acc = Conf.Key.(Set.add (hide_type k) acc) in 26 | Conf.Key.Set.empty 27 | |> add_key Conf.project_version 28 | (**) 29 | |> add_key Conf.uname 30 | |> add_key Conf.host_os 31 | |> add_key Conf.host_arch 32 | |> add_key Conf.host_word_size 33 | |> add_key Conf.target_os 34 | |> add_key Conf.target_arch 35 | |> add_key Conf.target_word_size 36 | (**) 37 | |> add_key Conf.root_dir 38 | |> add_key Conf.build_dir 39 | (**) 40 | |> add_key Conf.debug 41 | |> add_key Conf.profile 42 | |> add_key Conf.warn_error 43 | |> add_key Conf.test 44 | |> add_key Conf.doc 45 | |> add_key Conf.jobs 46 | (**) 47 | |> add_key Conf.ocaml_native_tools 48 | |> add_key Conf.ocaml_version 49 | |> add_key Conf.ocaml_byte 50 | |> add_key Conf.ocaml_native 51 | |> add_key Conf.ocaml_native_dynlink 52 | |> add_key Conf.ocaml_build_ast 53 | |> add_key Conf.ocaml_js 54 | |> add_key Conf.ocaml_annot 55 | |> add_key Conf.ocaml_dumpast 56 | |> add_key Conf.ocamlc 57 | |> add_key Conf.ocamlopt 58 | |> add_key Conf.js_of_ocaml 59 | |> add_key Conf.ocamldep 60 | |> add_key Conf.ocamlmklib 61 | |> add_key Conf.ocamldoc 62 | |> add_key Conf.ocamllex 63 | |> add_key Conf.ocamlyacc 64 | |> add_key Conf.ocaml 65 | |> add_key Conf.ocamlrun 66 | |> add_key Conf.ocamldebug 67 | |> add_key Conf.ocamlprof 68 | |> add_key Conf.ocamlfind 69 | |> add_key Conf.opam 70 | |> add_key Conf.opam_installer 71 | |> add_key Conf.opam_admin 72 | (**) 73 | |> add_key Conf.c_dynlink 74 | |> add_key Conf.c_js 75 | |> add_key Conf.cc 76 | |> add_key Conf.pkg_config 77 | (**) 78 | |> add_key Conf.ln 79 | |> add_key Conf.cp 80 | |> add_key Conf.mv 81 | |> add_key Conf.cd 82 | |> add_key Conf.rm 83 | |> add_key Conf.rmdir 84 | |> add_key Conf.mkdir 85 | |> add_key Conf.cat 86 | |> add_key Conf.make 87 | 88 | open Cmdliner 89 | 90 | let main () = 91 | let conf = Driver.Conf_spec test_keys in 92 | let man = Driver.Conf_spec.man test_keys in 93 | let main conf = Format.fprintf "@[%a@]@." Conf.pp conf in 94 | let main = Term.(pure main $ conf) in 95 | let exec_name = Filename.basename Sys.argv.(0) in 96 | let info = 97 | let doc = "inspect all built-in configuration keys" in 98 | Term.info exec_name ~doc ~man 99 | in 100 | match Term.eval (main, info) with `Error _ -> exit 1 | _ -> exit 0 101 | 102 | let () = main () 103 | --------------------------------------------------------------------------------