├── BRZO ├── .ocp-indent ├── .gitignore ├── .merlin ├── src-care ├── topkg_care.mllib ├── topkg_care_ocamlfind.mli ├── topkg_care_ocamlbuild.mli ├── topkg_care.ml ├── topkg_care_ocamlfind.ml ├── topkg_care_ipc.mli ├── topkg_care_text.mli ├── topkg_care_delegate.mli ├── topkg_care_opam.mli ├── topkg_care_ipc.ml ├── topkg_care_ocamlbuild.ml ├── topkg_care_archive.mli ├── topkg_care_pkg.mli ├── topkg_care_archive.ml ├── topkg_care_delegate.ml ├── topkg_care_text.ml └── topkg_care_opam.ml ├── doc ├── index-topkg.mld ├── index-topkg-care.mld └── index.mld ├── _tags ├── src ├── topkg.mllib ├── topkg_test.mli ├── topkg_publish.mli ├── topkg_fpath.mli ├── topkg_test.ml ├── topkg_fexts.mli ├── topkg_cmd.mli ├── topkg_main.mli ├── topkg_ipc.mli ├── topkg_result.mli ├── topkg_log.mli ├── topkg_publish.ml ├── topkg_fexts.ml ├── topkg_string.mli ├── topkg_result.ml ├── topkg_cmd.ml ├── topkg_build.mli ├── topkg_install.mli ├── topkg_fpath.ml ├── topkg_vcs.mli ├── topkg_distrib.mli ├── topkg_codec.mli ├── topkg_opam.mli ├── topkg_os.mli ├── topkg_pkg.mli ├── topkg_conf.mli ├── topkg_ipc.ml ├── topkg_log.ml ├── topkg.ml ├── topkg_build.ml ├── topkg_opam.ml ├── topkg_string.ml ├── topkg_distrib.ml └── topkg_codec.ml ├── src-bin ├── doc.mli ├── help.mli ├── ipc.mli ├── lint.mli ├── log.mli ├── opam.mli ├── run.mli ├── tag.mli ├── test.mli ├── bistro.mli ├── browse.mli ├── build.mli ├── clean.mli ├── distrib.mli ├── issue.mli ├── publish.mli ├── status.mli ├── bistro.ml ├── topkg_bin.ml ├── ipc.ml ├── clean.ml ├── lint.ml ├── cli.mli ├── tag.ml ├── status.ml ├── test.ml ├── run.ml ├── build.ml ├── browse.ml ├── publish.ml ├── issue.ml ├── log.ml ├── doc.ml ├── cli.ml ├── distrib.ml └── opam.ml ├── test ├── test.ml ├── unsupportive-delegate └── echo-delegate ├── pkg ├── META └── pkg.ml ├── LICENSE.md ├── DEVEL.md ├── topkg.opam ├── topkg-care.opam ├── README.md └── B0.ml /BRZO: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /.ocp-indent: -------------------------------------------------------------------------------- 1 | strict_with=always,match_clause=4,strict_else=never 2 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | _b0 2 | _build 3 | tmp 4 | *.install 5 | *.native 6 | *.byte -------------------------------------------------------------------------------- /.merlin: -------------------------------------------------------------------------------- 1 | PKG b0.kit rresult astring fmt fpath logs bos cmdliner 2 | PKG webbrowser webbrowser.cli opam-format 3 | S src 4 | S src-bin 5 | S src-care 6 | S test 7 | B _build/** 8 | -------------------------------------------------------------------------------- /src-care/topkg_care.mllib: -------------------------------------------------------------------------------- 1 | Topkg_care 2 | Topkg_care_archive 3 | Topkg_care_delegate 4 | Topkg_care_ipc 5 | Topkg_care_ocamlbuild 6 | Topkg_care_ocamlfind 7 | Topkg_care_opam 8 | Topkg_care_pkg 9 | Topkg_care_text 10 | -------------------------------------------------------------------------------- /doc/index-topkg.mld: -------------------------------------------------------------------------------- 1 | {0 Topkg {%html: %%VERSION%%%}} 2 | 3 | {b Warning.} Topkg is in maintenance mode and should not longer be 4 | used. 5 | 6 | {1:library_topkg Library [topkg]} 7 | 8 | {!modules: Topkg} 9 | -------------------------------------------------------------------------------- /doc/index-topkg-care.mld: -------------------------------------------------------------------------------- 1 | {0 Topkg {%html: %%VERSION%%%}} 2 | 3 | {b Warning.} Topkg is in maintenance mode and should not longer be 4 | used. 5 | 6 | {1:library_topkg_care Library [topkg.care]} 7 | 8 | {!modules: Topkg_care } 9 | -------------------------------------------------------------------------------- /_tags: -------------------------------------------------------------------------------- 1 | true : bin_annot, safe_string 2 | 3 | <_b0> : -traverse 4 | : include 5 | 6 | : include 7 | : package(opam-format cmdliner fmt.cli logs.cli bos.setup), \ 8 | package(webbrowser webbrowser.cli) 9 | 10 | : include 11 | : include -------------------------------------------------------------------------------- /doc/index.mld: -------------------------------------------------------------------------------- 1 | {0 Topkg {%html: %%VERSION%%%}} 2 | 3 | {b Warning.} Topkg is in maintenance mode and should not longer be 4 | used. 5 | 6 | {1:library_topkg Library [topkg]} 7 | 8 | {!modules: Topkg} 9 | 10 | {1:library_topkg_care Library [topkg.care]} 11 | 12 | {!modules: Topkg_care } 13 | -------------------------------------------------------------------------------- /src/topkg.mllib: -------------------------------------------------------------------------------- 1 | Topkg 2 | Topkg_build 3 | Topkg_cmd 4 | Topkg_codec 5 | Topkg_conf 6 | Topkg_distrib 7 | Topkg_fexts 8 | Topkg_fpath 9 | Topkg_install 10 | Topkg_ipc 11 | Topkg_log 12 | Topkg_main 13 | Topkg_opam 14 | Topkg_os 15 | Topkg_pkg 16 | Topkg_publish 17 | Topkg_result 18 | Topkg_string 19 | Topkg_test 20 | Topkg_vcs -------------------------------------------------------------------------------- /src-bin/doc.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** The [doc] command. *) 7 | 8 | val cmd : int Cmdliner.Cmd.t 9 | -------------------------------------------------------------------------------- /src-bin/help.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** The [help] command. *) 7 | 8 | val cmd : int Cmdliner.Cmd.t 9 | -------------------------------------------------------------------------------- /src-bin/ipc.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** The [ipc] command. *) 7 | 8 | val cmd : int Cmdliner.Cmd.t 9 | -------------------------------------------------------------------------------- /src-bin/lint.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** The [lint] command. *) 7 | 8 | val cmd : int Cmdliner.Cmd.t 9 | -------------------------------------------------------------------------------- /src-bin/log.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** The [log] command. *) 7 | 8 | val cmd : int Cmdliner.Cmd.t 9 | -------------------------------------------------------------------------------- /src-bin/opam.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** The [opam] command. *) 7 | 8 | val cmd : int Cmdliner.Cmd.t 9 | -------------------------------------------------------------------------------- /src-bin/run.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** The [run] command. *) 7 | 8 | val cmd : int Cmdliner.Cmd.t 9 | -------------------------------------------------------------------------------- /src-bin/tag.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** The [tag] command. *) 7 | 8 | val cmd : int Cmdliner.Cmd.t 9 | -------------------------------------------------------------------------------- /src-bin/test.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** The [test] command. *) 7 | 8 | val cmd : int Cmdliner.Cmd.t 9 | -------------------------------------------------------------------------------- /src-bin/bistro.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** The [bistro] command. *) 7 | 8 | val cmd : int Cmdliner.Cmd.t 9 | -------------------------------------------------------------------------------- /src-bin/browse.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** The [browse] command. *) 7 | 8 | val cmd : int Cmdliner.Cmd.t 9 | -------------------------------------------------------------------------------- /src-bin/build.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** The [build] command. *) 7 | 8 | val cmd : int Cmdliner.Cmd.t 9 | -------------------------------------------------------------------------------- /src-bin/clean.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** The [clean] command. *) 7 | 8 | val cmd : int Cmdliner.Cmd.t 9 | -------------------------------------------------------------------------------- /src-bin/distrib.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** The [distrib] command. *) 7 | 8 | val cmd : int Cmdliner.Cmd.t 9 | -------------------------------------------------------------------------------- /src-bin/issue.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** The [issue] command. *) 7 | 8 | val cmd : int Cmdliner.Cmd.t 9 | -------------------------------------------------------------------------------- /src-bin/publish.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** The [publish] command. *) 7 | 8 | val cmd : int Cmdliner.Cmd.t 9 | -------------------------------------------------------------------------------- /src-bin/status.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** The [status] command. *) 7 | 8 | val cmd : int Cmdliner.Cmd.t 9 | -------------------------------------------------------------------------------- /test/test.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | let () = 7 | let args = String.concat " " (List.tl (Array.to_list Sys.argv)) in 8 | Printf.printf "The test is ok, the arguments are: %s\n" args 9 | -------------------------------------------------------------------------------- /src-care/topkg_care_ocamlfind.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** [ocamlfind] helpers. 7 | 8 | See {!Topkg_care.OCamlfind}. *) 9 | 10 | (** {1 OCamlfind} *) 11 | 12 | open Bos_setup 13 | 14 | val cmd : Cmd.t 15 | val base_packages : String.set 16 | -------------------------------------------------------------------------------- /src-care/topkg_care_ocamlbuild.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** [ocamlbuild] helpers. 7 | 8 | See {!Topkg_care.OCamlbuild}. *) 9 | 10 | (** {1 OCamlbuild} *) 11 | 12 | open Bos_setup 13 | 14 | val cmd : Cmd.t 15 | val package_tags : ?roots:bool -> Fpath.t -> (String.set, R.msg) result 16 | -------------------------------------------------------------------------------- /src-care/topkg_care.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | module Text = Topkg_care_text 7 | module Pp = Topkg_care_text.Pp 8 | module Opam = Topkg_care_opam 9 | module OCamlbuild = Topkg_care_ocamlbuild 10 | module OCamlfind = Topkg_care_ocamlfind 11 | module Archive = Topkg_care_archive 12 | module Pkg = Topkg_care_pkg 13 | module Delegate = Topkg_care_delegate 14 | -------------------------------------------------------------------------------- /src-care/topkg_care_ocamlfind.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Bos_setup 7 | 8 | let cmd = 9 | Cmd.of_list @@ Topkg.Cmd.to_list @@ Topkg.Conf.tool "ocamlfind" `Host_os 10 | 11 | let base_packages = String.Set.of_list 12 | [ "bigarray"; "bytes"; "compiler-libs"; "dynlink"; "graphics"; "num"; 13 | "ocamldoc"; "stdlib"; "str"; "threads"; "unix" ] 14 | -------------------------------------------------------------------------------- /src/topkg_test.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** Topkg test description. *) 7 | 8 | type t 9 | 10 | val v : 11 | Topkg_fpath.t -> args:Topkg_cmd.t -> run:bool -> 12 | dir:Topkg_fpath.t option -> t 13 | 14 | val exec : t -> Topkg_fpath.t 15 | val args : t -> Topkg_cmd.t 16 | val run : t -> bool 17 | val dir : t -> Topkg_fpath.t option 18 | val codec : t Topkg_codec.t 19 | -------------------------------------------------------------------------------- /pkg/META: -------------------------------------------------------------------------------- 1 | description = "The transitory OCaml software packager" 2 | version = "%%VERSION_NUM%%" 3 | requires = "" 4 | archive(byte) = "topkg.cma" 5 | archive(native) = "topkg.cmxa" 6 | plugin(byte) = "topkg.cma" 7 | plugin(native) = "topkg.cmxs" 8 | 9 | package "care" ( 10 | directory = "../topkg-care" 11 | description = "Topkg package care tools" 12 | version = "%%VERSION_NUM%%" 13 | requires = "topkg opam-format cmdliner bos.setup" 14 | archive(byte) = "topkg_care.cma" 15 | archive(native) = "topkg_care.cmxa" 16 | plugin(byte) = "topkg_care.cma" 17 | plugin(native) = "topkg_care.cmxs" 18 | exists_if = "topkg_care.cma" 19 | ) 20 | -------------------------------------------------------------------------------- /src/topkg_publish.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** {1 Distribution publication description} 7 | 8 | See {!section:Topkg.Pkg.publish}. *) 9 | 10 | (** {1 Distribution} *) 11 | 12 | open Topkg_result 13 | 14 | (* Publication *) 15 | 16 | type artefact = [`Distrib | `Doc | `Alt of string] 17 | type t 18 | 19 | val v : ?artefacts:artefact list -> unit -> t 20 | val artefacts : t -> artefact list 21 | val codec : t Topkg_codec.t 22 | -------------------------------------------------------------------------------- /src/topkg_fpath.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** File system paths. 7 | 8 | See {!Topkg.Fpath}. *) 9 | 10 | (** {1 File system paths} *) 11 | 12 | type t = string 13 | val append : t -> t -> t 14 | val ( // ) : t -> t -> t 15 | 16 | val is_dir_path : t -> bool 17 | val is_file_path : t -> bool 18 | 19 | val basename : t -> string 20 | val dirname : t -> string 21 | 22 | val get_ext : t -> string 23 | val has_ext : string -> t -> bool 24 | val rem_ext : t -> t 25 | -------------------------------------------------------------------------------- /src-care/topkg_care_ipc.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** IPC with package description files *) 7 | 8 | (** {1 Asking packages} *) 9 | 10 | open Bos_setup 11 | 12 | val ocaml : Cmd.t 13 | (** [ocaml] is a command for [ocaml] looked up using 14 | {!Topkg.Conf.tool}[ "ocaml" `Build_os]. *) 15 | 16 | val ask : pkg_file:Fpath.t -> 'a Topkg.Private.Ipc.t -> ('a, R.msg) result 17 | (** [ask pkg_file ipc] performs the IPC [ipc] with the package description 18 | file [pkg_file] using the interpreter {!ocaml}. *) 19 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | Copyright (c) 2016 Daniel C. Bünzli 2 | 3 | Permission to use, copy, modify, and/or distribute this software for any 4 | purpose with or without fee is hereby granted, provided that the above 5 | copyright notice and this permission notice appear in all copies. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 8 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 9 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 10 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 11 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 12 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 13 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 14 | -------------------------------------------------------------------------------- /src/topkg_test.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | type t = 7 | { exec : Topkg_fpath.t; 8 | args : Topkg_cmd.t; 9 | run : bool; 10 | dir : Topkg_fpath.t option; } 11 | 12 | let v exec ~args ~run ~dir = { exec; args; run; dir } 13 | let exec t = t.exec 14 | let args t = t.args 15 | let run t = t.run 16 | let dir t = t.dir 17 | let codec = 18 | let fields = 19 | (fun t -> (t.exec, t.args, t.run, t.dir)), 20 | (fun (exec, args, run, dir) -> { exec; args; run; dir}) 21 | in 22 | Topkg_codec.(view ~kind:"test" fields (t4 fpath cmd bool (option fpath))) 23 | -------------------------------------------------------------------------------- /src/topkg_fexts.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** File extensions. 7 | 8 | See {!Topkg.Exts} for documentation. *) 9 | 10 | (** {1 File extensions} *) 11 | 12 | type ext = [`Ext of string | `Obj | `Real_clib | `Lib | `Dll | `Exe] 13 | 14 | type t = ext list 15 | 16 | val interface : ext list 17 | val api : ext list 18 | val cmx : ext list 19 | val real_c_library : ext list 20 | val c_library : ext list 21 | val c_dll_library : ext list 22 | val library : ext list 23 | val module_library : ext list 24 | val exe : ext list 25 | val exts : string list -> ext list 26 | val ext : string -> ext list 27 | val ext_to_string : Topkg_conf.OCaml.t -> ext -> string 28 | -------------------------------------------------------------------------------- /src/topkg_cmd.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** Command lines 7 | 8 | See {!Topkg.Cmd} for documentation. *) 9 | 10 | (** {1 Command lines} *) 11 | 12 | type t 13 | 14 | val v : string -> t 15 | val empty : t 16 | val is_empty : t -> bool 17 | val ( % ) : t -> string -> t 18 | val ( %% ) : t -> t -> t 19 | val add_arg : t -> string -> t 20 | val add_args : t -> t -> t 21 | val on : bool -> t -> t 22 | val p : Topkg_fpath.t -> string 23 | 24 | val equal : t -> t -> bool 25 | val compare : t -> t -> int 26 | 27 | val to_rev_list : t -> string list 28 | val to_list : t -> string list 29 | val of_list : ?slip:string -> string list -> t 30 | val dump : Format.formatter -> t -> unit 31 | -------------------------------------------------------------------------------- /src/topkg_main.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** Entry point for [pkg.ml] files. *) 7 | 8 | (** {1 Main} *) 9 | 10 | open Topkg_result 11 | 12 | val describe : 13 | ?delegate:Topkg_cmd.t -> 14 | ?readmes:Topkg_pkg.std_file list -> 15 | ?licenses:Topkg_pkg.std_file list -> 16 | ?change_logs:Topkg_pkg.std_file list -> 17 | ?metas:Topkg_pkg.meta_file list -> 18 | ?opams:Topkg_pkg.opam_file list -> 19 | ?lint_files:Topkg_fpath.t list option -> 20 | ?lint_custom:(unit -> R.msg result list) -> 21 | ?distrib:Topkg_distrib.t -> 22 | ?publish:Topkg_publish.t -> 23 | ?build:Topkg_build.t -> 24 | string -> (Topkg_conf.t -> Topkg_install.t list result) -> unit 25 | 26 | val disable : unit -> unit 27 | -------------------------------------------------------------------------------- /src/topkg_ipc.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** Topkg interprocess communication. 7 | 8 | See {!Topkg.Private.Ipc} for documentation. *) 9 | 10 | open Topkg_result 11 | 12 | (** {1 Interprocess communication} *) 13 | 14 | type 'a t 15 | 16 | val v : ?answer:Topkg_fpath.t -> Topkg_cmd.t -> 'a Topkg_codec.t -> 'a t 17 | val cmd : 'a t -> Topkg_cmd.t 18 | val codec : 'a t -> 'a Topkg_codec.t 19 | val answer : 'a t -> Topkg_fpath.t 20 | 21 | val pkg : unit -> Topkg_pkg.t t 22 | val lint_custom : unit -> Topkg_result.R.msg Topkg_result.result list option t 23 | val distrib_prepare : 24 | dist_build_dir:string -> name:string -> version:string -> opam:string -> 25 | opam_adds:string -> Topkg_fpath.t list result t 26 | 27 | val write_answer : Topkg_cmd.t -> Topkg_pkg.t -> unit Topkg_result.result 28 | -------------------------------------------------------------------------------- /src/topkg_result.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** Results 7 | 8 | Abbridged [rresult]. See {!section:Topkg.prels} for documention. *) 9 | 10 | val ( >>= ) : ('a, 'b) result -> ('a -> ('c, 'b) result) -> ('c, 'b) result 11 | val ( >>| ) : ('a, 'b) result -> ('a -> 'c) -> ('c, 'b) result 12 | 13 | type ('a, 'b) r = ('a, 'b) result = Ok of 'a | Error of 'b 14 | type 'a result = ('a, [ `Msg of string]) r 15 | 16 | module R : sig 17 | val reword_error : ('b -> 'c) -> ('a, 'b) r -> ('a, 'c) r 18 | 19 | type msg = [ `Msg of string ] 20 | 21 | val msgf : ('a, Format.formatter, unit, [> msg]) format4 -> 'a 22 | 23 | val error_msg : string -> ('b, [> msg]) r 24 | val error_msgf : 25 | ('a, Format.formatter, unit, ('b, [> msg]) r) format4 -> 'a 26 | 27 | val reword_error_msg : 28 | ?replace:bool -> (string -> msg) -> ('a, msg) r -> ('a, [> msg]) r 29 | end 30 | -------------------------------------------------------------------------------- /src/topkg_log.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** Log 7 | 8 | Abridged [logs]. See {!Topkg.Log} for documentation. *) 9 | 10 | (** {1 Log} *) 11 | 12 | open Topkg_result 13 | 14 | type level = App | Error | Warning | Info | Debug 15 | 16 | val level : unit -> level option 17 | val set_level : level option -> unit 18 | val level_to_string : level option -> string 19 | val level_of_string : string -> (level option, [`Msg of string]) r 20 | 21 | type 'a msgf = 22 | (?header:string -> ('a, Format.formatter, unit) format -> 'a) -> unit 23 | 24 | val msg : level -> 'a msgf -> unit 25 | val app : 'a msgf -> unit 26 | val err : 'a msgf -> unit 27 | val warn : 'a msgf -> unit 28 | val info : 'a msgf -> unit 29 | val debug : 'a msgf -> unit 30 | 31 | val on_error_msg : ?level:level -> use:(unit -> 'a) -> 'a result -> 'a 32 | val err_count : unit -> int 33 | val warn_count : unit -> int 34 | -------------------------------------------------------------------------------- /src/topkg_publish.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Topkg_result 7 | 8 | type artefact = [`Distrib | `Doc | `Alt of string] 9 | type t = { artefacts : artefact list } 10 | 11 | let v ?(artefacts = [`Doc; `Distrib]) () = { artefacts } 12 | let artefacts p = p.artefacts 13 | let codec_artefact = 14 | let tag = function `Distrib -> 0 | `Doc -> 1 | `Alt _ -> 2 in 15 | let codecs = 16 | let alt_case = 17 | ((function `Alt s -> s | _ -> assert false), 18 | (function s -> `Alt s)) 19 | in 20 | Topkg_codec.([| const `Distrib; const `Doc; view alt_case string |]) 21 | in 22 | Topkg_codec.alt ~kind:"artefact" tag codecs 23 | 24 | let codec = 25 | let artefacts = Topkg_codec.(list codec_artefact) in 26 | let fields = 27 | (fun p -> p.artefacts), 28 | (fun artefacts -> { artefacts }) 29 | in 30 | Topkg_codec.version 0 @@ 31 | Topkg_codec.(view ~kind:"publish" fields artefacts) 32 | -------------------------------------------------------------------------------- /src/topkg_fexts.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | type ext = [ `Ext of string | `Obj | `Real_clib | `Lib | `Dll | `Exe ] 7 | type t = ext list 8 | 9 | let interface = [ `Ext ".mli"; `Ext ".cmi"; `Ext ".cmti"; ] 10 | let cmx = [ `Ext ".cmx" ] 11 | let api = interface @ cmx 12 | let real_c_library = [ `Real_clib ] 13 | let c_library = [ `Lib ] 14 | let c_dll_library = [ `Dll ] 15 | let library = [` Ext ".cma"; `Ext ".cmxa"; `Ext ".cmxs" ] @ c_library 16 | let module_library = (api @ library) 17 | let exe = [ `Exe ] 18 | let ext e = [ `Ext e ] 19 | let exts es = List.map (fun e -> `Ext e) es 20 | 21 | let ext_to_string c = 22 | let ext_obj = Topkg_conf.OCaml.ext_obj c in 23 | let ext_lib = Topkg_conf.OCaml.ext_lib c in 24 | let ext_dll = Topkg_conf.OCaml.ext_dll c in 25 | let ext_exe = Topkg_conf.OCaml.ext_exe c in 26 | function 27 | | `Ext s -> s 28 | | `Obj -> ext_obj 29 | | `Lib | `Real_clib -> ext_lib 30 | | `Dll -> ext_dll 31 | | `Exe -> ext_exe 32 | -------------------------------------------------------------------------------- /src/topkg_string.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** Strings. 7 | 8 | See {!Topkg.String} for documentation. *) 9 | 10 | val strf : ('a, Format.formatter, unit, string) format4 -> 'a 11 | 12 | include module type of String 13 | 14 | val head : string -> char option 15 | 16 | val is_prefix : affix:string -> string -> bool 17 | val is_suffix : affix:string -> string -> bool 18 | val for_all : (char -> bool) -> string -> bool 19 | val exists : (char -> bool) -> string -> bool 20 | 21 | val find_byte : ?start:int -> char -> string -> int option 22 | 23 | val trim : string -> string 24 | val cut : ?rev:bool -> sep:char -> string -> (string * string) option 25 | val cuts : ?empty:bool -> sep:char -> string -> string list 26 | 27 | val with_index_range : ?first:int -> ?last:int -> string -> string 28 | 29 | val uppercase_ascii : string -> string 30 | 31 | val parse_version : string -> (int * int * int * string option) option 32 | val drop_initial_v : string -> string 33 | 34 | val pp_text : Format.formatter -> string -> unit 35 | -------------------------------------------------------------------------------- /src/topkg_result.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | let ( >>= ) v f = match v with Ok v -> f v | Error _ as e -> e 7 | let ( >>| ) v f = match v with Ok v -> Ok (f v) | Error _ as e -> e 8 | 9 | type ('a, 'b) r = ('a, 'b) result = Ok of 'a | Error of 'b 10 | type 'a result = ('a, [`Msg of string]) r 11 | 12 | module R = struct 13 | type msg = [`Msg of string ] 14 | 15 | let msgf fmt = 16 | let kmsg _ = `Msg (Format.flush_str_formatter ()) in 17 | Format.kfprintf kmsg Format.str_formatter fmt 18 | 19 | let reword_error reword = function 20 | | Ok _ as r -> r 21 | | Error e -> Error (reword e) 22 | 23 | let error_msg m = Error (`Msg m) 24 | let error_msgf fmt = 25 | let kerr _ = Error (`Msg (Format.flush_str_formatter ())) in 26 | Format.kfprintf kerr Format.str_formatter fmt 27 | 28 | let reword_error_msg ?(replace = false) reword = function 29 | | Ok _ as r -> r 30 | | Error (`Msg e) -> 31 | let (`Msg e' as v) = reword e in 32 | if replace then Error v else error_msgf "%s\n%s" e e' 33 | end 34 | -------------------------------------------------------------------------------- /src-care/topkg_care_text.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** Text processing helpers. 7 | 8 | See {!Topkg_care.Text}. *) 9 | 10 | (** {1 Text} *) 11 | 12 | open Bos_setup 13 | 14 | type flavour = [ `Markdown | `Asciidoc ] 15 | 16 | val flavour_of_fpath : Fpath.t -> flavour option 17 | val head : ?flavour:flavour -> string -> (string * string) option 18 | val header_title : ?flavour:flavour -> string -> string 19 | 20 | val change_log_last_entry : 21 | ?flavour:flavour -> string -> (string * (string * string)) option 22 | 23 | val change_log_file_last_entry : 24 | Fpath.t -> ((string * (string * string)), R.msg) result 25 | 26 | val split_uri : ?rel:bool -> string -> (string * string * string) option 27 | 28 | val find_pager : don't:bool -> (Cmd.t option, R.msg) result 29 | val edit_file : Fpath.t -> (int, R.msg) result 30 | 31 | module Pp : sig 32 | val name : string Fmt.t 33 | val version : string Fmt.t 34 | val commit : string Fmt.t 35 | val dirty : unit Fmt.t 36 | val path : Fpath.t Fmt.t 37 | val status : [`Ok | `Fail] Fmt.t 38 | end 39 | -------------------------------------------------------------------------------- /src-care/topkg_care_delegate.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** Package delegate. 7 | 8 | See {!Topkg_care.Delegate} for documentation. *) 9 | 10 | open Bos_setup 11 | 12 | (** {1 Publish} *) 13 | 14 | val publish_distrib : 15 | Topkg_care_pkg.t -> msg:string -> archive:Fpath.t -> 16 | (unit, R.msg) result 17 | 18 | val publish_doc : 19 | Topkg_care_pkg.t -> msg:string -> docdir:Fpath.t -> 20 | (unit, R.msg) result 21 | 22 | val publish_alt : 23 | Topkg_care_pkg.t -> kind:string -> msg:string -> archive:Fpath.t -> 24 | (unit, R.msg) result 25 | 26 | val publish_in_git_branch : 27 | remote:string -> branch:string -> 28 | name:string -> version:string -> docdir:Fpath.t -> 29 | dir:Fpath.t -> (unit, R.msg) result 30 | 31 | (** {1 Delegate} *) 32 | 33 | val issue_list : Topkg_care_pkg.t -> (unit, R.msg) result 34 | val issue_show : Topkg_care_pkg.t -> id:string -> (unit, R.msg) result 35 | 36 | val issue_open : 37 | Topkg_care_pkg.t -> title:string -> body:string -> (unit, R.msg) result 38 | 39 | val issue_close : 40 | Topkg_care_pkg.t -> id:string -> msg:string -> (unit, R.msg) result 41 | -------------------------------------------------------------------------------- /src/topkg_cmd.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (* Command line fragments *) 7 | 8 | type t = string list 9 | 10 | let empty = [] 11 | let is_empty = function [] -> true | _ -> false 12 | let v a = [a] 13 | let ( % ) l a = a :: l 14 | let ( %% ) l0 l1 = List.rev_append (List.rev l1) l0 15 | let add_arg l a = l % a 16 | let add_args l a = l %% a 17 | let on bool l = if bool then l else [] 18 | let p f = f 19 | 20 | (* Predicates and comparison *) 21 | 22 | let equal l l' = l = l' 23 | let compare l l' = compare l l' 24 | 25 | (* Conversions and pretty printing *) 26 | 27 | let to_rev_list line = line 28 | let to_list line = List.rev line 29 | let of_list ?slip line = match slip with 30 | | None -> List.rev line 31 | | Some slip -> List.fold_left (fun acc v -> v :: slip :: acc) [] line 32 | 33 | let dump ppf cmd = 34 | let pp_elt ppf s = Format.fprintf ppf "%s" (Filename.quote s) in 35 | let rec loop = function 36 | | [] -> () 37 | | v :: vs -> 38 | if vs = [] then pp_elt ppf v else 39 | (Format.fprintf ppf "%a@ " pp_elt v; loop vs) 40 | in 41 | Format.fprintf ppf "@[<1>["; loop (List.rev cmd); Format.fprintf ppf "]@]" 42 | -------------------------------------------------------------------------------- /src-care/topkg_care_opam.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** opam interaction. 7 | 8 | See {!Topkg_care.Opam}. *) 9 | 10 | (** {1 opam} *) 11 | 12 | open Bos_setup 13 | 14 | val cmd : Cmd.t 15 | val ensure_publish : unit -> (unit, R.msg) result 16 | val submit : ?msg:string -> opam_file:Fpath.t -> unit -> (unit, R.msg) result 17 | val ocaml_base_packages : String.set 18 | 19 | module File : sig 20 | val field_names : String.set 21 | val fields : Fpath.t -> ((string list) String.map , R.msg) result 22 | val deps : ?opts:bool -> (string list) String.map -> String.set 23 | end 24 | 25 | module Descr : sig 26 | type t = string * string 27 | val of_string : string -> (t, R.msg) result 28 | val to_string : t -> string 29 | val to_opam_fields : t -> string 30 | val of_readme : 31 | ?flavour:Topkg_care_text.flavour -> string -> (t, R.msg) result 32 | val of_readme_file : Fpath.t -> (t, R.msg) result 33 | end 34 | 35 | module Url : sig 36 | type t = string 37 | val v : uri:string -> checksum:string -> t 38 | val with_distrib_file : uri:string -> Fpath.t -> (t, R.msg) result 39 | val to_opam_section : t -> string 40 | end 41 | -------------------------------------------------------------------------------- /test/unsupportive-delegate: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ocaml 2 | #use "topfind" 3 | #require "bos.setup" 4 | open Bos_setup 5 | 6 | let unsupported = Ok 1 7 | 8 | let publish = function 9 | | "distrib" :: uri :: name :: version :: msg :: archive :: _ -> 10 | unsupported 11 | | "doc" :: uri :: name :: version :: msg :: docdir :: _ -> 12 | unsupported 13 | | "alt" :: kind :: uri :: name :: version :: msg :: archive :: _ -> 14 | unsupported 15 | | args -> 16 | unsupported 17 | 18 | let issue = function 19 | | "list" :: uri :: _ -> unsupported 20 | | "show" :: uri :: id :: _ -> unsupported 21 | | "open" :: uri :: title :: descr :: _ -> unsupported 22 | | "close" :: uri :: id :: msg :: _ -> unsupported 23 | | args -> unsupported 24 | 25 | let request = function 26 | | "publish" :: args -> publish args 27 | | "issue" :: args -> issue args 28 | | args -> unsupported 29 | 30 | let main () = 31 | let doc = "the unsupportive delegate" in 32 | begin match OS.Arg.(parse ~doc ~pos:string ()) with 33 | | "ipc" :: verbosity :: req -> 34 | Logs.level_of_string verbosity 35 | >>= fun level -> Logs.set_level level; request req 36 | | "ipc" :: [] -> 37 | R.error_msg "malformed delegate request, verbosity is missing" 38 | | args -> 39 | R.error_msgf "unknown arguments: %s" (String.concat ~sep:" " args) 40 | end 41 | |> Logs.on_error_msg ~use:(fun () -> 2) 42 | 43 | let () = exit (main ()) 44 | -------------------------------------------------------------------------------- /src-care/topkg_care_ipc.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Bos_setup 7 | 8 | let ocaml = 9 | Cmd.of_list @@ Topkg.Cmd.to_list @@ Topkg.Conf.tool "ocaml" `Build_os 10 | 11 | let pkg_must_exist pkg_file = match OS.File.must_exist pkg_file with 12 | | Ok _ -> Ok pkg_file 13 | | Error _ -> 14 | let p = match OS.Dir.current () with 15 | | Error _ -> (* ignore *) pkg_file 16 | | Ok dir -> Fpath.(dir // pkg_file) 17 | in 18 | R.error_msgf "Not a package: no file %a" Fpath.pp p 19 | 20 | let ask ~pkg_file ipc = 21 | let codec = Topkg.Private.Ipc.codec ipc in 22 | let verbosity = Logs.(level_to_string (level ())) in 23 | let ipc_cmd = Cmd.of_list @@ Topkg.Cmd.to_list @@ Topkg.Private.Ipc.cmd ipc in 24 | let cmd = Cmd.(ocaml % p pkg_file % "ipc" % verbosity %% ipc_cmd) in 25 | pkg_must_exist pkg_file >>= fun pkg_file -> 26 | begin 27 | OS.Cmd.run cmd 28 | >>= fun () -> Fpath.of_string (Topkg.Private.Ipc.answer ipc) 29 | >>= fun answer -> OS.File.read answer 30 | >>= fun data -> Topkg.Private.Codec.dec_result codec data 31 | end 32 | |> R.reword_error_msg 33 | (fun _ -> R.msgf "Failed to load package description %a" Fpath.pp pkg_file) 34 | -------------------------------------------------------------------------------- /src-care/topkg_care_ocamlbuild.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Bos_setup 7 | 8 | let cmd = 9 | Cmd.of_list @@ Topkg.Cmd.to_list @@ Topkg.Conf.tool "ocamlbuild" `Host_os 10 | 11 | let find_packages ~roots s = 12 | let package = String.sub "package(" in 13 | let not_rpar c = not (Char.equal ')' c) in 14 | let not_dot c = not (Char.equal '.' c) in 15 | let is_comma c = Char.equal ',' c in 16 | let is_sep c = Char.Ascii.is_white c || is_comma c in 17 | let rec loop acc s = match String.Sub.find_sub ~sub:package s with 18 | | None -> acc 19 | | Some s -> 20 | let rest = String.Sub.(extend (stop s)) in 21 | let ids, rest = String.Sub.span ~sat:not_rpar rest in 22 | let ids = String.Sub.fields ~empty:false ~is_sep ids in 23 | let add_id acc id = 24 | let id = if roots then String.Sub.take ~sat:not_dot id else id in 25 | String.Set.add (String.Sub.to_string id) acc 26 | in 27 | let acc = List.fold_left add_id acc ids in 28 | loop acc (String.Sub.tail rest) 29 | in 30 | loop String.Set.empty (String.sub s) 31 | 32 | let package_tags ?(roots = false) file = 33 | OS.File.read file >>= fun contents -> Ok (find_packages ~roots contents) 34 | -------------------------------------------------------------------------------- /DEVEL.md: -------------------------------------------------------------------------------- 1 | Package structure 2 | ----------------- 3 | 4 | This repo is the base of two opam packages: 5 | 6 | - `topkg`, with opam file [topkg.opam](topkg.opam) 7 | - `topkg-care` with opam file [topkg-care.opam](topkg-care.opam) 8 | 9 | Both share the same [pkg/pkg.ml](pkg/pkg.ml) file. `topkg` simply 10 | builds the `Topkg` library and `topkg-care` builds the `Topkg_care` 11 | library and the `topkg` command line tool. The distinction is made in 12 | the `pkg.ml` file based on the package name passed to the build 13 | instructions. 14 | 15 | The reason for this structure is that while both `Topkg` and `Topkg_care` 16 | could be distributed together and `Topkg_care` be simply build 17 | depending on optional dependencies being present, this would have a 18 | fatal flaw: `topkg` cannot be used for any of `Topkg_care`'s 19 | dependencies. Since we want to use `topkg` for these dependencies 20 | aswell, this structure allows to cut the dependency cycle that would 21 | occur. 22 | 23 | So if you want to develop `topkg` you should do a: 24 | 25 | ``` 26 | opam pin add -kgit topkg topkg#master 27 | opam pin add -kgit topkg-care topkg#master 28 | ``` 29 | 30 | Changing the Topkg API 31 | ---------------------- 32 | 33 | Is a *very* delicate thing to do as it could break packages. Here's an 34 | invocation that can be used to reinstall packages that build depend on 35 | `topkg`: 36 | 37 | ``` 38 | opam reinstall $(opam list -s --installed --depends-on topkg) 39 | ``` 40 | -------------------------------------------------------------------------------- /src/topkg_build.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** Package build description. *) 7 | 8 | open Topkg_result 9 | 10 | (** {1 Build} *) 11 | 12 | type t 13 | 14 | val build_cmd : Topkg_conf.t -> Topkg_conf.os -> Topkg_cmd.t 15 | val clean_cmd : Topkg_conf.os -> build_dir:Topkg_fpath.t -> Topkg_cmd.t 16 | 17 | val v : 18 | ?prepare_on_pin:bool -> 19 | ?dir:Topkg_fpath.t -> 20 | ?pre:(Topkg_conf.t -> unit result) -> 21 | ?cmd:(Topkg_conf.t -> Topkg_conf.os -> Topkg_fpath.t list -> unit result) -> 22 | ?post:(Topkg_conf.t -> unit result) -> 23 | ?clean:(Topkg_conf.os -> build_dir:Topkg_fpath.t -> unit result) -> 24 | unit -> t 25 | 26 | val with_dir : t -> Topkg_fpath.t -> t 27 | 28 | val prepare_on_pin : t -> bool 29 | val dir : t -> Topkg_fpath.t 30 | val pre : t -> (Topkg_conf.t -> unit result) 31 | val cmd : 32 | t -> (Topkg_conf.t -> Topkg_conf.os -> Topkg_fpath.t list -> unit result) 33 | 34 | val post : t -> (Topkg_conf.t -> unit result) 35 | val clean : t -> (Topkg_conf.os -> build_dir:Topkg_fpath.t -> unit result) 36 | 37 | val codec : t Topkg_codec.t 38 | 39 | val ocb_tag : Topkg_conf.t -> 'a Topkg_conf.key -> string -> Topkg_cmd.t 40 | val ocb_bool_tag : Topkg_conf.t -> bool Topkg_conf.key -> string -> Topkg_cmd.t 41 | val ocb_bool_tags : 42 | Topkg_conf.t -> (bool Topkg_conf.key * string) list -> Topkg_cmd.t 43 | -------------------------------------------------------------------------------- /src/topkg_install.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** Package install. *) 7 | 8 | (** {1 Install} *) 9 | 10 | type t 11 | 12 | val nothing : t 13 | val flatten : t list -> t 14 | val to_build : 15 | ?header:string -> 16 | Topkg_conf.t -> 17 | Topkg_conf.os -> t list -> 18 | (Topkg_fpath.t list * Topkg_opam.Install.t * Topkg_test.t list option) 19 | 20 | type field = 21 | ?force:bool -> ?built:bool -> ?cond:bool -> ?exts:Topkg_fexts.t -> 22 | ?dst:string -> string -> t 23 | 24 | val bin : ?auto:bool -> field 25 | val doc : field 26 | val etc : field 27 | val lib : field 28 | val lib_root : field 29 | val libexec : ?auto:bool -> field 30 | val libexec_root : ?auto:bool -> field 31 | val man : field 32 | val misc : field 33 | val sbin : ?auto:bool -> field 34 | val share : field 35 | val share_root : field 36 | val stublibs : field 37 | val toplevel : field 38 | val unknown : string -> field 39 | 40 | val test : 41 | ?run:bool -> ?dir:Topkg_fpath.t -> ?args:Topkg_cmd.t -> ?auto:bool -> field 42 | 43 | val mllib : 44 | ?field:field -> ?cond:bool -> ?cma:bool -> ?cmxa:bool -> ?cmxs:bool -> 45 | ?api:string list -> ?dst_dir:Topkg_fpath.t -> Topkg_fpath.t -> t 46 | 47 | val clib : 48 | ?dllfield:field -> 49 | ?libfield:field -> 50 | ?cond:bool -> ?lib_dst_dir:Topkg_fpath.t -> Topkg_fpath.t -> t 51 | 52 | val codec : t Topkg_codec.t 53 | -------------------------------------------------------------------------------- /src/topkg_fpath.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | type t = string 7 | 8 | let dir_sep_prefix s = 9 | Topkg_string.is_prefix ~affix:Filename.dir_sep s || 10 | (String.length s > 0 && s.[0] = '/') 11 | 12 | let dir_sep_suffix s = 13 | Topkg_string.is_suffix ~affix:Filename.dir_sep s || 14 | (String.length s > 0 && s.[String.length s - 1] = '/') 15 | 16 | let append = 17 | fun p q -> match p with 18 | | "" -> q 19 | | p -> 20 | match q with 21 | | "" -> p 22 | | q -> 23 | if dir_sep_prefix q then q else 24 | if dir_sep_suffix p then (p ^ q) else 25 | (p ^ "/" ^ q) 26 | 27 | let ( // ) = append 28 | 29 | let is_dir_path p = match p with 30 | | "." | ".." -> true 31 | | _ -> 32 | let is_suffix affix = Topkg_string.is_suffix ~affix p in 33 | List.exists is_suffix ["/"; "/.."; "/."] 34 | 35 | let is_file_path p = not (is_dir_path p) 36 | 37 | let basename s = Filename.basename s 38 | let dirname s = Filename.dirname s 39 | 40 | let last_dot_index s = try Some (String.rindex s '.') with Not_found -> None 41 | let get_ext s = match last_dot_index s with 42 | | None -> "" 43 | | Some i -> Topkg_string.with_index_range ~first:i s 44 | 45 | let has_ext e p = Topkg_string.is_suffix ~affix:e p 46 | 47 | let rem_ext s = match last_dot_index s with 48 | | None -> s 49 | | Some i -> Topkg_string.with_index_range ~last:(i - 1) s 50 | -------------------------------------------------------------------------------- /src-bin/bistro.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Bos_setup 7 | 8 | let bistro () = 9 | begin 10 | let verb = Cmd.(v "--verbosity" % Logs.(level_to_string (level ()))) in 11 | let topkg = Cmd.(v "topkg") in 12 | OS.Cmd.run Cmd.(topkg % "distrib" %% verb) 13 | >>= fun () -> OS.Cmd.run Cmd.(topkg % "publish" %% verb) 14 | >>= fun () -> OS.Cmd.run Cmd.(topkg % "opam" %% verb % "pkg") 15 | >>= fun () -> OS.Cmd.run Cmd.(topkg % "opam" %% verb % "submit") 16 | >>= fun () -> Ok 0 17 | end 18 | |> Cli.handle_error 19 | 20 | (* Command line interface *) 21 | 22 | open Cmdliner 23 | 24 | let doc = "For when you are in a hurry or need to go for a drink" 25 | let sdocs = Manpage.s_common_options 26 | let exits = Cli.exits 27 | let man_xrefs = [ `Main; `Cmd "distrib"; `Cmd "publish"; `Cmd "opam" ] 28 | let man = 29 | [ `S Manpage.s_description; 30 | `P "The $(tname) command (quick in Russian) is equivalent to invoke:"; 31 | `Pre "\ 32 | topkg distrib # Create the distribution archive 33 | topkg publish # Publish it on the WWW with its documentation 34 | topkg opam pkg # Create an opam package 35 | topkg opam submit # Submit it to OCaml's opam repository"; 36 | `P "See topkg-release(7) for more information."; ] 37 | 38 | let cmd = 39 | Cmd.v (Cmd.info "bistro" ~doc ~sdocs ~exits ~man ~man_xrefs) @@ 40 | Term.(const bistro $ Cli.setup) 41 | -------------------------------------------------------------------------------- /test/echo-delegate: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ocaml 2 | #use "topfind" 3 | #require "bos.setup" 4 | #require "fmt" 5 | open Bos_setup 6 | 7 | let ok = Ok 0 8 | let unsupported = Ok 1 9 | 10 | let publish = function 11 | | "distrib" :: uri :: name :: version :: msg :: archive :: _ -> 12 | Fmt.pr "publish distrib %S %S %S %S %S@." uri name version msg archive; ok 13 | | "doc" :: uri :: name :: version :: msg :: docdir :: _ -> 14 | Fmt.pr "publish doc %S %S %S %S %S@." uri name version msg docdir; ok 15 | | "alt" :: k :: uri :: name :: version :: msg :: archive :: _ -> 16 | Fmt.pr "publish alt %S %S %S %S %S %S@." k uri name version msg archive; ok 17 | | args -> 18 | unsupported 19 | 20 | let issue = function 21 | | "list" :: uri :: _ -> Fmt.pr "issue list %S@." uri; ok 22 | | "show" :: uri :: id :: _ -> Fmt.pr "issue show %S %S@." uri id; ok 23 | | "open" :: uri :: t :: d :: _ -> Fmt.pr "issue open %S %S %S@." uri t d; ok 24 | | "close" :: uri :: id :: m :: _ -> Fmt.pr "issue close %S %S %S@." uri id m; ok 25 | | args -> unsupported 26 | 27 | let request = function 28 | | "publish" :: args -> publish args 29 | | "issue" :: args -> issue args 30 | | args -> unsupported 31 | 32 | let main () = 33 | let doc = "the unsupportive delegate" in 34 | begin match OS.Arg.(parse ~doc ~pos:string ()) with 35 | | "ipc" :: verbosity :: req -> 36 | Logs.level_of_string verbosity 37 | >>= fun level -> Logs.set_level level; request req 38 | | "ipc" :: [] -> 39 | R.error_msg "malformed delegate request, verbosity is missing" 40 | | args -> 41 | R.error_msgf "unknown arguments: %s" (String.concat ~sep:" " args) 42 | end 43 | |> Logs.on_error_msg ~use:(fun () -> 2) 44 | 45 | let () = exit (main ()) 46 | -------------------------------------------------------------------------------- /src-bin/topkg_bin.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Cmdliner 7 | 8 | let cmds = 9 | [ Bistro.cmd; Browse.cmd; Build.cmd; Clean.cmd; Distrib.cmd; Doc.cmd; 10 | Help.cmd; Ipc.cmd; Issue.cmd; Lint.cmd; Log.cmd; Opam.cmd; 11 | Publish.cmd; Run.cmd; Status.cmd; Tag.cmd; Test.cmd; ] 12 | 13 | let main () = `Help (`Pager, None) 14 | 15 | (* Command line interface *) 16 | 17 | let doc = "Topkg package care" 18 | let sdocs = Manpage.s_common_options 19 | let exits = Cli.exits 20 | let man = 21 | [ `S Manpage.s_description; 22 | `P "$(mname) takes care of topkg packages."; 23 | `P "Use '$(mname) help release' for help to release a package."; 24 | `Noblank; 25 | `P "Use '$(mname) help delegate' for help about the topkg delegate."; 26 | `Noblank; 27 | `P "Use '$(mname) help troubleshoot' for a few troubleshooting tips."; 28 | `Noblank; 29 | `P "Use '$(mname) help $(i,COMMAND)' for help about $(i,COMMAND)."; 30 | `S Manpage.s_bugs; 31 | `P "Report them, see $(i,%%PKG_HOMEPAGE%%) for contact information."; 32 | `S Manpage.s_authors; 33 | `P "Daniel C. Buenzli, $(i,http://erratique.ch)"; ] 34 | 35 | let main = 36 | let default = Term.(ret (const main $ Cli.setup)) in 37 | let info = Cmd.info "topkg" ~version:"%%VERSION%%" ~doc ~sdocs ~exits ~man in 38 | Cmd.group ~default info cmds 39 | 40 | let main () = 41 | Topkg.Private.disable_main (); 42 | Cmd.eval' main 43 | 44 | let () = if !Sys.interactive then () else exit (main ()) 45 | -------------------------------------------------------------------------------- /src-care/topkg_care_archive.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** Archive creation. 7 | 8 | See {!Topkg_care.Archive}. *) 9 | 10 | open Bos_setup 11 | 12 | (** {1 Ustar archives} *) 13 | 14 | (** ustar encoder. 15 | 16 | {b References}. 17 | {{:http://pubs.opengroup.org/onlinepubs/9699919799/utilities/pax.html#tag_20_92_13_06}ustar Interchange Format} in POSIX 1003.1, 2013. *) 18 | module Tar : sig 19 | 20 | (** {1 Ustar encoder} *) 21 | 22 | type ptime = int 23 | (** The type for POSIX times in seconds since the epoch. *) 24 | 25 | type t 26 | (** The type for ustar archives. *) 27 | 28 | val empty : t 29 | (** [empty] is the empty ustar archive. *) 30 | 31 | val add : 32 | t -> Fpath.t -> mode:int -> mtime:ptime -> [`Dir | `File of string ] -> 33 | (t, R.msg) result 34 | (** [add a f mode mtime kind] adds to archive [a] an element of 35 | type [kind] with file path [f], permission mode [mode] and modificaton 36 | time [mtime]. *) 37 | 38 | val to_string : t -> string 39 | (** [to_string a] is the byte serialization of the archive [a]. *) 40 | end 41 | 42 | val tar : 43 | Fpath.t -> exclude_paths:Fpath.set -> root:Fpath.t -> mtime:int -> 44 | (string, R.msg) result 45 | 46 | (** {1 Bzip2 compression and unarchiving} *) 47 | 48 | val ensure_bzip2 : unit -> (unit, R.msg) result 49 | val bzip2 : string -> dst:Fpath.t -> (unit, R.msg) result 50 | val ensure_tar : unit -> (unit, R.msg) result 51 | val untbz : ?clean:bool -> Fpath.t -> (Fpath.t, R.msg) result 52 | -------------------------------------------------------------------------------- /src/topkg_vcs.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** VCS repositories. 7 | 8 | See {!Topkg.Vcs} for documentation. *) 9 | 10 | (** {1 VCS} *) 11 | 12 | open Topkg_result 13 | 14 | type kind = [ `Git | `Hg ] 15 | val pp_kind : Format.formatter -> kind -> unit 16 | 17 | type commit_ish = string 18 | 19 | type t 20 | 21 | val kind : t -> kind 22 | val dir : t -> Topkg_fpath.t 23 | val find : ?dir:Topkg_fpath.t -> unit -> t option result 24 | val get : ?dir:Topkg_fpath.t -> unit -> t result 25 | val cmd : t -> Topkg_cmd.t 26 | val pp : Format.formatter -> t -> unit 27 | 28 | val is_dirty : t -> bool result 29 | val not_dirty : t -> unit result 30 | val file_is_dirty : t -> Topkg_fpath.t -> bool result 31 | val head : ?dirty:bool -> t -> string result 32 | val commit_id : ?dirty:bool -> ?commit_ish:string -> t -> string result 33 | val commit_ptime_s : ?commit_ish:commit_ish -> t -> int result 34 | val describe : ?dirty:bool -> ?commit_ish:string -> t -> string result 35 | val tags : t -> string list result 36 | val changes : 37 | ?until:string -> t -> after:string -> (string * string) list result 38 | 39 | val tracked_files : ?tree_ish:string -> t -> Topkg_fpath.t list result 40 | 41 | val clone : t -> dir:Topkg_fpath.t -> unit result 42 | val checkout : ?branch:string -> t -> commit_ish:string -> unit result 43 | val commit_files : ?msg:string -> t -> Topkg_fpath.t list -> unit result 44 | 45 | val delete_tag : t -> string -> unit result 46 | val tag : 47 | ?force:bool -> ?sign:bool -> ?msg:string -> ?commit_ish:string -> t -> 48 | string -> unit result 49 | -------------------------------------------------------------------------------- /src/topkg_distrib.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** {1 Distribution description} 7 | 8 | See {!section:Topkg.Pkg.distrib}. *) 9 | 10 | (** {1 Distribution} *) 11 | 12 | open Topkg_result 13 | 14 | (* Watermarks *) 15 | 16 | type watermark = 17 | string * 18 | [ `String of string | `Name | `Version | `Version_num | `Vcs of [ `Commit_id ] 19 | | `Opam of Topkg_fpath.t option * string * string ] 20 | 21 | val define_watermarks : 22 | name:string -> version:string -> opam:Topkg_fpath.t -> 23 | watermark list -> (string * string) list 24 | 25 | val watermark_file : (string * string) list -> Topkg_fpath.t -> unit result 26 | val watermark_files : 27 | (string * string) list -> Topkg_fpath.t list -> unit result 28 | 29 | (* Distribution *) 30 | 31 | type t 32 | 33 | val v : 34 | ?watermarks:watermark list -> 35 | ?files_to_watermark:(unit -> Topkg_fpath.t list result) -> 36 | ?massage:(unit -> unit result) -> 37 | ?exclude_paths:(unit -> Topkg_fpath.t list result) -> 38 | ?uri:string -> 39 | unit -> t 40 | 41 | val watermarks : t -> watermark list 42 | val files_to_watermark : t -> (unit -> Topkg_fpath.t list result) 43 | val massage : t -> (unit -> unit result) 44 | val exclude_paths : t -> (unit -> Topkg_fpath.t list result) 45 | val uri : t -> string option 46 | val codec : t Topkg_codec.t 47 | 48 | (* Defaults *) 49 | 50 | val default_watermarks : watermark list 51 | val default_files_to_watermark : unit -> Topkg_fpath.t list result 52 | val default_massage : unit -> unit result 53 | val default_exclude_paths : unit -> Topkg_fpath.t list result 54 | -------------------------------------------------------------------------------- /src-bin/ipc.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Bos_setup 7 | 8 | let opam_fields file = 9 | begin 10 | Logs.info begin fun m -> 11 | m ~header:"IPC" "opam fields of %s with cwd %a" file 12 | (R.pp ~ok:Fpath.pp ~error:R.pp_msg) (OS.Dir.current ()) 13 | end; 14 | Fpath.of_string file 15 | >>= fun file -> Topkg_care.Opam.File.fields file 16 | >>= fun fs -> Ok (String.Map.bindings fs) 17 | >>= fun fs -> Ok (Topkg.Private.(Codec.enc Opam.File.codec fs)) 18 | >>= fun enc -> OS.File.(write dash enc) 19 | end 20 | |> R.reword_error_msg ~replace:true 21 | (fun msg -> R.msgf "ipc opam-fields: %s" msg) 22 | 23 | let ipc_answer = function 24 | | ["opam-fields"; file] -> opam_fields file 25 | | args -> R.error_msgf "ipc: unknown arguments %a" Cmd.dump (Cmd.of_list args) 26 | 27 | let ipc () args = match ipc_answer args with 28 | | Ok () -> `Ok 0 29 | | Error (`Msg msg) -> `Error (false, msg) 30 | 31 | (* Command line interface *) 32 | 33 | open Cmdliner 34 | 35 | let args = 36 | let doc = "IPC call arguments" in 37 | Arg.(value (pos_all string [] & info [] ~doc ~docv:"ARG")) 38 | 39 | let doc = "Interprocess communication with package description files" 40 | let sdocs = Manpage.s_common_options 41 | let exits = Cli.exits 42 | let man_xrefs = [`Main] 43 | let man = 44 | [ `S Manpage.s_description; 45 | `P "The $(tname) command is used by package description files. It is 46 | undocumented." ] 47 | 48 | let cmd = 49 | Cmd.v (Cmd.info "ipc" ~doc ~sdocs ~exits ~man ~man_xrefs) @@ 50 | Term.(ret (const ipc $ Cli.setup $ args)) 51 | -------------------------------------------------------------------------------- /src-bin/clean.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Bos_setup 7 | 8 | (* Command *) 9 | 10 | let clean_args name build_dir = 11 | let on_some_use_opt opt to_arg = function 12 | | None -> Cmd.empty 13 | | Some value -> Cmd.(v opt % to_arg value) 14 | in 15 | let verb = Cli.propagate_verbosity_to_pkg_file () in 16 | let build_dir = on_some_use_opt "--build-dir" Cmd.p build_dir in 17 | let name = on_some_use_opt "--pkg-name" (fun n -> n) name in 18 | Cmd.(verb %% name %% build_dir) 19 | 20 | let clean () pkg_file name build_dir = 21 | let pkg = Topkg_care.Pkg.v ?build_dir ?name pkg_file in 22 | let args = clean_args name build_dir in 23 | let out = OS.Cmd.out_stdout in 24 | begin 25 | OS.Dir.current () 26 | >>= fun dir -> Topkg_care.Pkg.clean pkg ~dir ~args ~out 27 | >>| (function ((), (_, `Exited 0)) -> 0 | _ -> 1) 28 | end 29 | |> Cli.handle_error 30 | 31 | (* Command line interface *) 32 | 33 | open Cmdliner 34 | 35 | let doc = "Clean the package's build" 36 | let sdocs = Manpage.s_common_options 37 | let exits = Cmd.Exit.info 1 ~doc:"on clean failure." :: Cli.exits 38 | let man_xrefs = [`Main; `Cmd "build"] 39 | let man = 40 | [ `S Manpage.s_synopsis; 41 | `P "$(mname) $(tname) [$(i,OPTION)]..."; 42 | `S Manpage.s_description; 43 | `P "The $(tname) command deletes the package's build and its opam 44 | install file. This is equivalent to invoke:"; 45 | `Pre "ocaml ./pkg/pkg.ml clean";] 46 | 47 | let cmd = 48 | Cmd.v (Cmd.info "clean" ~doc ~sdocs ~exits ~man ~man_xrefs) @@ 49 | Term.(const clean $ Cli.setup $ Cli.pkg_file $ Cli.pkg_name $ Cli.build_dir) 50 | -------------------------------------------------------------------------------- /src/topkg_codec.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** Topkg interprocess communication codec. 7 | 8 | See {!Topkg.Private.Codec} for documentation. *) 9 | 10 | (** {1 Codec} *) 11 | 12 | open Topkg_result 13 | 14 | type error = Corrupted of (string * string) | Version of int * int 15 | val pp_error : Format.formatter -> error -> unit 16 | exception Error of error 17 | val err : kind:string -> string -> 'a 18 | 19 | type 'a t 20 | 21 | val v : kind:string -> enc:('a -> string) -> dec:(string -> 'a) -> 'a t 22 | val kind : 'a t -> string 23 | val enc : 'a t -> 'a -> string 24 | val dec : 'a t -> string -> 'a 25 | val dec_result : 'a t -> string -> 'a result 26 | val with_kind : string -> 'a t -> 'a t 27 | val write : Topkg_fpath.t -> 'a t -> 'a -> unit result 28 | val read : Topkg_fpath.t -> 'a t -> 'a result 29 | 30 | val unit : unit t 31 | val const : 'a -> 'a t 32 | val bool : bool t 33 | val int : int t 34 | val string : string t 35 | val option : 'a t -> 'a option t 36 | val result : ok:'a t -> error:'b t -> ('a, 'b) r t 37 | val list : 'a t -> 'a list t 38 | val pair : 'a t -> 'b t -> ('a * 'b) t 39 | val t2 : 'a t -> 'b t -> ('a * 'b) t 40 | val t3 : 'a t -> 'b t -> 'c t -> ('a * 'b * 'c) t 41 | val t4 : 'a t -> 'b t -> 'c t -> 'd t -> ('a * 'b * 'c * 'd) t 42 | val t5 : 'a t -> 'b t -> 'c t -> 'd t -> 'e t -> ('a * 'b * 'c * 'd * 'e) t 43 | val alt : kind:string -> ('a -> int) -> 'a t array -> 'a t 44 | val version : int -> 'a t -> 'a t 45 | val view : ?kind:string -> ('a -> 'b) * ('b -> 'a) -> 'b t -> 'a t 46 | 47 | val msg : [`Msg of string ] t 48 | val result_error_msg : 'a t -> 'a result t 49 | 50 | val fpath : Topkg_fpath.t t 51 | val cmd : Topkg_cmd.t t 52 | -------------------------------------------------------------------------------- /src/topkg_opam.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** opam helpers. 7 | 8 | See also {!Topkg.Private.Opam}. *) 9 | 10 | open Topkg_result 11 | 12 | module File : sig 13 | type t = (string * string list) list 14 | val codec : t Topkg_codec.t 15 | val fields : Topkg_fpath.t -> t result 16 | end 17 | 18 | (** opam install file. 19 | 20 | A module to generate opam install files. 21 | 22 | {b Reference}. 23 | {{:http://opam.ocaml.org/doc/manual/dev-manual.html#sec25} 24 | Syntax and semantics} of opam install files. *) 25 | module Install : sig 26 | 27 | (** {1 opam install files} *) 28 | 29 | type field = 30 | [ `Bin 31 | | `Doc 32 | | `Etc 33 | | `Lib 34 | | `Lib_root 35 | | `Libexec 36 | | `Libexec_root 37 | | `Man 38 | | `Misc 39 | | `Sbin 40 | | `Share 41 | | `Share_root 42 | | `Stublibs 43 | | `Toplevel 44 | | `Unknown of string ] 45 | (** The type for opam install file fields. *) 46 | 47 | type move 48 | (** The type for file moves. *) 49 | 50 | val move : ?maybe:bool -> ?dst:Topkg_fpath.t -> Topkg_fpath.t -> move 51 | (** [move ~maybe ~dst src] moves [src] to [dst], where [dst] is a 52 | path relative to the directory corresponding to the 53 | {{!field}field}. If [maybe] is [true] (defaults to [false]), 54 | then [src] may not exist, otherwise an install error will occur 55 | if the file doesn't exist. *) 56 | 57 | type t = [ `Header of string option ] * (field * move) list 58 | (** The type for opam install files. An optional starting header 59 | comment and a list of field moves. *) 60 | 61 | val to_string : t -> string 62 | (** [to_string t] is [t] as syntactically valid opam install file. *) 63 | end 64 | -------------------------------------------------------------------------------- /topkg.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "topkg" 3 | synopsis: "The transitory OCaml software packager" 4 | description: """\ 5 | **Warning** Topkg is in maintenance mode and should not longer be used. 6 | 7 | Topkg is a packager for distributing OCaml software. It provides an 8 | API to describe the files a package installs in a given build 9 | configuration and to specify information about the package's 10 | distribution, creation and publication procedures. 11 | 12 | The optional topkg-care package provides the `topkg` command line tool 13 | which helps with various aspects of a package's life cycle: creating 14 | and linting a distribution, releasing it on the WWW, publish its 15 | documentation, add it to the OCaml opam repository, etc. 16 | 17 | Topkg is distributed under the ISC license and has **no** 18 | dependencies. This is what your packages will need as a *build* 19 | dependency. 20 | 21 | Topkg-care is distributed under the ISC license it depends on 22 | [fmt][fmt], [logs][logs], [bos][bos], [cmdliner][cmdliner], 23 | [webbrowser][webbrowser] and `opam-format`. 24 | 25 | [fmt]: http://erratique.ch/software/fmt 26 | [logs]: http://erratique.ch/software/logs 27 | [bos]: http://erratique.ch/software/bos 28 | [cmdliner]: http://erratique.ch/software/cmdliner 29 | [webbrowser]: http://erratique.ch/software/webbrowser 30 | 31 | Home page: """ 32 | maintainer: "Daniel Bünzli " 33 | authors: "The topkg programmers" 34 | license: "ISC" 35 | tags: ["packaging" "ocamlbuild" "org:erratique"] 36 | homepage: "https://erratique.ch/software/topkg" 37 | doc: "https://erratique.ch/software/topkg/doc" 38 | bug-reports: "https://github.com/dbuenzli/topkg/issues" 39 | depends: [ 40 | "ocaml" {>= "4.08.0"} 41 | "ocamlfind" {build & >= "1.6.1"} 42 | "ocamlbuild" 43 | ] 44 | build: ["ocaml" "pkg/pkg.ml" "build" "--pkg-name" name "--dev-pkg" "%{dev}%"] 45 | dev-repo: "git+https://erratique.ch/repos/topkg.git" 46 | x-maintenance-intent: ["(latest)"] 47 | -------------------------------------------------------------------------------- /pkg/pkg.ml: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env ocaml 2 | #use "topfind" 3 | 4 | (* Bootstrap from source, note #mod_use is 4.01 *) 5 | #directory "src" 6 | #mod_use "topkg_result.ml" 7 | #mod_use "topkg_string.ml" 8 | #mod_use "topkg_log.ml" 9 | #mod_use "topkg_fpath.ml" 10 | #mod_use "topkg_cmd.ml" 11 | #mod_use "topkg_os.ml" 12 | #mod_use "topkg_vcs.ml" 13 | #mod_use "topkg_codec.ml" 14 | #mod_use "topkg_conf.ml" 15 | #mod_use "topkg_fexts.ml" 16 | #mod_use "topkg_opam.ml" 17 | #mod_use "topkg_test.ml" 18 | #mod_use "topkg_install.ml" 19 | #mod_use "topkg_build.ml" 20 | #mod_use "topkg_distrib.ml" 21 | #mod_use "topkg_publish.ml" 22 | #mod_use "topkg_pkg.ml" 23 | #mod_use "topkg_ipc.ml" 24 | #mod_use "topkg_main.ml" 25 | #mod_use "topkg.ml" 26 | 27 | open Topkg 28 | 29 | let () = 30 | let metas = [ Pkg.meta_file ~install:false "pkg/META" ] in 31 | let opams = 32 | let install = false in 33 | let not_topkg_deps = 34 | Some ["fmt"; "logs"; "bos"; "cmdliner"; "webbrowser"; "opam-format"] 35 | in 36 | [ Pkg.opam_file ~install "topkg.opam" ~lint_deps_excluding:not_topkg_deps; 37 | Pkg.opam_file ~install "topkg-care.opam" ] 38 | in 39 | Pkg.describe ~metas ~opams "topkg" @@ fun c -> 40 | match (* bootstrap, Conf doesn't work, eqs *) Topkg_conf.pkg_name c with 41 | | "topkg" -> 42 | Ok [ Pkg.lib "pkg/META"; 43 | Pkg.lib "topkg.opam" ~dst:"opam"; 44 | Pkg.mllib ~api:["Topkg"] "src/topkg.mllib"; 45 | Pkg.doc "doc/index-topkg.mld" ~dst:"odoc-pages/index.mld"; 46 | Pkg.test "test/test"; ] 47 | | "topkg-care" -> 48 | Ok [ Pkg.lib "topkg-care.opam" ~dst:"opam"; 49 | Pkg.mllib ~api:["Topkg_care"] "src-care/topkg_care.mllib"; 50 | Pkg.bin "src-bin/topkg_bin" ~dst:"topkg"; 51 | Pkg.bin "src-bin/toy_github_delegate" 52 | ~dst:"toy-github-topkg-delegate"; 53 | Pkg.doc "doc/index-topkg-care.mld" ~dst:"odoc-pages/index.mld"; 54 | Pkg.doc "test/unsupportive-delegate"; 55 | Pkg.doc "test/echo-delegate" ] 56 | | other -> 57 | R.error_msgf "unknown package name: %s" other 58 | -------------------------------------------------------------------------------- /src-bin/lint.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Bos_setup 7 | 8 | let lint () pkg_file ignore_pkg lints = 9 | begin 10 | let pkg = Topkg_care.Pkg.v pkg_file in 11 | OS.Dir.current () 12 | >>= fun dir -> Topkg_care.Pkg.lint ~ignore_pkg pkg ~dir lints 13 | end 14 | |> Cli.handle_error 15 | 16 | (* Command line interface *) 17 | 18 | open Cmdliner 19 | 20 | let lints = 21 | let test = [ "custom", `Custom; 22 | "std-files", `Std_files; 23 | "meta", `Meta; 24 | "opam", `Opam; 25 | "deps", `Deps; ] 26 | in 27 | let doc = strf "Test to perform. $(docv) must be one of %s. If unspecified 28 | all tests are performed." (Arg.doc_alts_enum test) 29 | in 30 | let test = Arg.enum test in 31 | let docv = "TEST" in 32 | Arg.(value & pos_all test Topkg_care.Pkg.lint_all & info [] ~doc ~docv) 33 | 34 | let ignore_pkg = 35 | let doc = "Ignore package description file." in 36 | Arg.(value & flag & info ["i"; "ignore-pkg"] ~doc) 37 | 38 | let doc = "Check package distribution consistency and conventions" 39 | let sdocs = Manpage.s_common_options 40 | let exits = Cmd.Exit.info 1 ~doc:"on lint failure" :: Cli.exits 41 | let man_xrefs = [`Main; `Cmd "distrib"] 42 | let man = 43 | [ `S Manpage.s_description; 44 | `P "The $(tname) command makes tests on a package distribution or 45 | source repository. It checks that standard files exist, that 46 | ocamlfind META files pass the ocamlfind lint test, that opam package 47 | files pass the opam lint test and that the opam dependencies are 48 | consistent with those of the build system."; 49 | `P "Linting is automatically performed on distribution generation, see 50 | topkg-distrib(1) for more details." ] 51 | 52 | let cmd = 53 | Cmd.v (Cmd.info "lint" ~doc ~sdocs ~exits ~man ~man_xrefs) 54 | Term.(const lint $ Cli.setup $ Cli.pkg_file $ ignore_pkg $ lints) 55 | -------------------------------------------------------------------------------- /topkg-care.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | name: "topkg-care" 3 | synopsis: "The transitory OCaml software packager" 4 | description: """\ 5 | **Warning** Topkg is in maintenance mode and should not longer be used. 6 | 7 | Topkg is a packager for distributing OCaml software. It provides an 8 | API to describe the files a package installs in a given build 9 | configuration and to specify information about the package's 10 | distribution, creation and publication procedures. 11 | 12 | The optional topkg-care package provides the `topkg` command line tool 13 | which helps with various aspects of a package's life cycle: creating 14 | and linting a distribution, releasing it on the WWW, publish its 15 | documentation, add it to the OCaml opam repository, etc. 16 | 17 | Topkg is distributed under the ISC license and has **no** 18 | dependencies. This is what your packages will need as a *build* 19 | dependency. 20 | 21 | Topkg-care is distributed under the ISC license it depends on 22 | [fmt][fmt], [logs][logs], [bos][bos], [cmdliner][cmdliner], 23 | [webbrowser][webbrowser] and `opam-format`. 24 | 25 | [fmt]: http://erratique.ch/software/fmt 26 | [logs]: http://erratique.ch/software/logs 27 | [bos]: http://erratique.ch/software/bos 28 | [cmdliner]: http://erratique.ch/software/cmdliner 29 | [webbrowser]: http://erratique.ch/software/webbrowser 30 | 31 | Home page: """ 32 | maintainer: "Daniel Bünzli " 33 | authors: "The topkg programmers" 34 | license: "ISC" 35 | tags: ["packaging" "ocamlbuild" "org:erratique"] 36 | homepage: "https://erratique.ch/software/topkg" 37 | doc: "https://erratique.ch/software/topkg/doc" 38 | bug-reports: "https://github.com/dbuenzli/topkg/issues" 39 | depends: [ 40 | "ocaml" {>= "4.08.0"} 41 | "ocamlfind" {build & >= "1.6.1"} 42 | "ocamlbuild" 43 | "topkg" {= version} 44 | "fmt" {>= "0.9.0"} 45 | "logs" 46 | "bos" {>= "0.2.1"} 47 | "cmdliner" {>= "1.3.0"} 48 | "webbrowser" 49 | "opam-format" {>= "2.0.0"} 50 | ] 51 | build: ["ocaml" "pkg/pkg.ml" "build" "--pkg-name" name "--dev-pkg" "%{dev}%"] 52 | dev-repo: "git+https://erratique.ch/repos/topkg.git" 53 | x-maintenance-intent: ["(latest)"] 54 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Topkg — The transitory OCaml software packager 2 | ============================================== 3 | 4 | **Warning** Topkg is in maintenance mode and should not longer be used. 5 | 6 | Topkg is a packager for distributing OCaml software. It provides an 7 | API to describe the files a package installs in a given build 8 | configuration and to specify information about the package's 9 | distribution, creation and publication procedures. 10 | 11 | The optional topkg-care package provides the `topkg` command line tool 12 | which helps with various aspects of a package's life cycle: creating 13 | and linting a distribution, releasing it on the WWW, publish its 14 | documentation, add it to the OCaml opam repository, etc. 15 | 16 | Topkg is distributed under the ISC license and has **no** 17 | dependencies. This is what your packages will need as a *build* 18 | dependency. 19 | 20 | Topkg-care is distributed under the ISC license it depends on 21 | [fmt][fmt], [logs][logs], [bos][bos], [cmdliner][cmdliner], 22 | [webbrowser][webbrowser] and `opam-format`. 23 | 24 | [fmt]: http://erratique.ch/software/fmt 25 | [logs]: http://erratique.ch/software/logs 26 | [bos]: http://erratique.ch/software/bos 27 | [cmdliner]: http://erratique.ch/software/cmdliner 28 | [webbrowser]: http://erratique.ch/software/webbrowser 29 | 30 | Home page: 31 | 32 | ## Installation 33 | 34 | Topkg and topkg-care can be installed with `opam`: 35 | 36 | opam install topkg # All you need for your packages 37 | opam install topkg-care # topkg binary, takes care of your packages 38 | 39 | If you don't use `opam` consult the [`topkg.opam`](topkg.opam) and 40 | [`topkg-care.opam`](topkg-care.opam) files for build instructions. 41 | 42 | ## Documentation 43 | 44 | A basic introduction and API reference is automatically generated by 45 | `ocamldoc` from the interfaces. It can be consulted [online][doc]. 46 | 47 | The `topkg` command line tool is extensively documented in man pages 48 | available through it's help system. Type: 49 | 50 | ``` 51 | topkg help release # for help about releasing your package 52 | topkg help # for more help 53 | ``` 54 | 55 | [doc]: http://erratique.ch/software/topkg/doc 56 | -------------------------------------------------------------------------------- /src/topkg_os.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** OS interaction. 7 | 8 | Abridged [bos]. See {!Topkg.OS} for documentation. *) 9 | 10 | (** {1 OS} *) 11 | 12 | open Topkg_result 13 | 14 | module Env : sig 15 | val var : string -> string option 16 | val opt_var : string -> absent:string -> string 17 | end 18 | 19 | module File : sig 20 | val null : Topkg_fpath.t 21 | val dash : Topkg_fpath.t 22 | 23 | val exists : Topkg_fpath.t -> bool result 24 | val must_exist : Topkg_fpath.t -> Topkg_fpath.t result 25 | val delete : ?must_exist:bool -> Topkg_fpath.t -> unit result 26 | 27 | val fold : 28 | ?skip:(Topkg_fpath.t -> bool) -> (Topkg_fpath.t -> 'a -> 'a) -> 29 | 'a -> Topkg_fpath.t list -> 'a result 30 | 31 | val read : Topkg_fpath.t -> string result 32 | val write : Topkg_fpath.t -> string -> unit result 33 | val write_subst : 34 | Topkg_fpath.t -> (string * string) list -> string -> unit result 35 | 36 | val tmp : unit -> Topkg_fpath.t result 37 | end 38 | 39 | module Dir : sig 40 | val exists : Topkg_fpath.t -> bool result 41 | val must_exist : Topkg_fpath.t -> Topkg_fpath.t result 42 | 43 | val current : unit -> Topkg_fpath.t result 44 | val set_current : Topkg_fpath.t -> unit result 45 | val with_current : Topkg_fpath.t -> ('a -> 'b) -> 'a -> 'b result 46 | 47 | val contents : 48 | ?dotfiles:bool -> ?rel:bool -> Topkg_fpath.t -> Topkg_fpath.t list result 49 | end 50 | 51 | module Cmd : sig 52 | val exists : Topkg_cmd.t -> bool result 53 | val must_exist : Topkg_cmd.t -> Topkg_cmd.t result 54 | 55 | val run : ?err:Topkg_fpath.t -> Topkg_cmd.t -> unit result 56 | val run_status : ?err:Topkg_fpath.t -> Topkg_cmd.t -> [`Exited of int] result 57 | 58 | 59 | type run_status = Topkg_cmd.t * [`Exited of int ] 60 | val success : ('a * run_status) result -> 'a result 61 | 62 | type run_out 63 | 64 | val out_string : ?trim:bool -> run_out -> (string * run_status) result 65 | val out_lines : ?trim:bool -> run_out -> (string list * run_status) result 66 | val out_file : Topkg_fpath.t -> run_out -> (unit * run_status) result 67 | val out_stdout : run_out -> (unit * run_status) result 68 | 69 | val to_string : ?trim:bool -> run_out -> string result 70 | val to_lines : ?trim:bool -> run_out -> string list result 71 | val to_file : Topkg_fpath.t -> run_out -> unit result 72 | val run_out : ?err:Topkg_fpath.t -> Topkg_cmd.t -> run_out 73 | end 74 | -------------------------------------------------------------------------------- /src-care/topkg_care_pkg.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** Package descriptions. 7 | 8 | See {!Topkg_care.Pkg} *) 9 | 10 | open Bos_setup 11 | 12 | (** {1 Package} *) 13 | 14 | type t 15 | 16 | val v : 17 | ?name:string -> 18 | ?version:string -> 19 | ?delegate:Cmd.t -> 20 | ?build_dir:Fpath.t -> 21 | ?opam:Fpath.t -> 22 | ?opam_descr:Fpath.t -> 23 | ?readme:Fpath.t -> 24 | ?change_log:Fpath.t -> 25 | ?license:Fpath.t -> 26 | ?distrib_uri:string -> 27 | ?distrib_file:Fpath.t -> 28 | ?publish_msg:string -> 29 | ?publish_artefacts:[ `Distrib | `Doc | `Alt of string] list -> 30 | Fpath.t -> t 31 | 32 | val pkg_file : t -> Fpath.t 33 | val name : t -> (string, R.msg) result 34 | val version : t -> (string, R.msg) result 35 | val delegate : t -> (Cmd.t, R.msg) result 36 | val build_dir : t -> (Fpath.t, R.msg) result 37 | val opam : t -> (Fpath.t, R.msg) result 38 | val opam_field : t -> string -> (string list option, R.msg) result 39 | val opam_field_hd : t -> string -> (string option, R.msg) result 40 | val opam_fields : t -> (string list String.map, R.msg) result 41 | val opam_descr : t -> (Topkg_care_opam.Descr.t * bool, R.msg) result 42 | val readmes : t -> (Fpath.t list, R.msg) result 43 | val readme : t -> (Fpath.t, R.msg) result 44 | val change_logs : t -> (Fpath.t list, R.msg) result 45 | val change_log : t -> (Fpath.t, R.msg) result 46 | val licenses : t -> (Fpath.t list, R.msg) result 47 | val distrib_uri : ?raw:bool -> t -> (string, R.msg) result 48 | val distrib_file : t -> (Fpath.t, R.msg) result 49 | val publish_msg : t -> (string, R.msg) result 50 | val publish_artefacts : t -> 51 | ([ `Distrib | `Doc | `Alt of string] list, R.msg) result 52 | 53 | (** {1 Test} *) 54 | 55 | val test : 56 | t -> dir:Fpath.t -> args:Cmd.t -> 57 | out:(OS.Cmd.run_out -> ('a, R.msg) result) -> ('a, R.msg) result 58 | 59 | (** {1 Build} *) 60 | 61 | val build : 62 | t -> dir:Fpath.t -> args:Cmd.t -> 63 | out:(OS.Cmd.run_out -> ('a, R.msg) result) -> ('a, R.msg) result 64 | 65 | (** {1 Clean} *) 66 | 67 | val clean : 68 | t -> dir:Fpath.t -> args:Cmd.t -> 69 | out:(OS.Cmd.run_out -> ('a, R.msg) result) -> ('a, R.msg) result 70 | 71 | (** {1 Distrib} *) 72 | 73 | val distrib_filename : ?opam:bool -> t -> (Fpath.t, R.msg) result 74 | val distrib_archive : t -> keep_dir:bool -> (Fpath.t, R.msg) result 75 | 76 | (** {1 Lint} *) 77 | 78 | type lint = [ `Custom | `Std_files | `Meta | `Opam | `Deps ] 79 | val lint_all : lint list 80 | val lint : 81 | ?ignore_pkg:bool -> t -> dir:Fpath.t -> lint list -> (int, R.msg) result 82 | -------------------------------------------------------------------------------- /src/topkg_pkg.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** Package descriptions. *) 7 | 8 | (** {1 Package} *) 9 | 10 | open Topkg_result 11 | 12 | type std_file 13 | val std_file : ?install:bool -> Topkg_fpath.t -> std_file 14 | 15 | type meta_file 16 | val meta_file : ?lint:bool -> ?install:bool -> Topkg_fpath.t -> meta_file 17 | 18 | type opam_file 19 | val opam_file : 20 | ?lint:bool -> ?lint_deps_excluding:string list option -> ?install:bool -> 21 | Topkg_fpath.t -> opam_file 22 | 23 | type t 24 | 25 | val empty : t 26 | val with_name_and_build_dir : 27 | ?name:string -> ?build_dir:Topkg_fpath.t -> t -> t 28 | 29 | val v : 30 | ?delegate:Topkg_cmd.t -> 31 | ?readmes:std_file list -> 32 | ?licenses:std_file list -> 33 | ?change_logs:std_file list -> 34 | ?metas:meta_file list -> 35 | ?opams:opam_file list -> 36 | ?lint_files:Topkg_fpath.t list option -> 37 | ?lint_custom:(unit -> R.msg result list) -> 38 | ?distrib:Topkg_distrib.t -> 39 | ?publish:Topkg_publish.t -> 40 | ?build:Topkg_build.t -> string -> 41 | (Topkg_conf.t -> Topkg_install.t list result) -> t 42 | 43 | val name : t -> string 44 | val delegate : t -> Topkg_cmd.t option 45 | val readmes : t -> Topkg_fpath.t list 46 | val change_logs : t -> Topkg_fpath.t list 47 | val licenses : t -> Topkg_fpath.t list 48 | val distrib : t -> Topkg_distrib.t 49 | val build : t -> Topkg_build.t 50 | val install : t -> Topkg_conf.t -> Topkg_install.t list result 51 | val codec : t Topkg_codec.t 52 | 53 | (* Derived accessors *) 54 | 55 | val build_dir : t -> Topkg_fpath.t 56 | val opam : name:string -> t -> Topkg_fpath.t 57 | 58 | (* Distrib *) 59 | 60 | val distrib_uri : t -> string option 61 | val distrib_prepare : 62 | t -> dist_build_dir:Topkg_fpath.t -> name:string -> version:string -> 63 | opam:Topkg_fpath.t -> opam_adds:string -> Topkg_fpath.t list result 64 | 65 | (* Publish *) 66 | 67 | val publish_artefacts : t -> [ `Distrib | `Doc | `Alt of string ] list 68 | 69 | (* Test *) 70 | 71 | val test : 72 | t -> list:bool -> tests:string list -> args:Topkg_cmd.t option -> int result 73 | 74 | (* Build *) 75 | 76 | val build : 77 | t -> kind:[`Build | `Dry_run | `Raw of string list ] -> 78 | Topkg_conf.t -> Topkg_conf.os -> int result 79 | 80 | (* Clean *) 81 | 82 | val clean : t -> Topkg_conf.os -> int result 83 | 84 | (* Lint *) 85 | 86 | val lint_custom : t -> (unit -> R.msg result list) option 87 | val lint_files : t -> Topkg_fpath.t list option 88 | val lint_metas : t -> (Topkg_fpath.t * bool) list 89 | val lint_opams : t -> (Topkg_fpath.t * bool * string list option) list 90 | -------------------------------------------------------------------------------- /src/topkg_conf.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** Build configuration 7 | 8 | See {!Topkg.Conf}. *) 9 | 10 | open Topkg_result 11 | 12 | (** {1 Configuration key value converters} *) 13 | 14 | type 'a conv 15 | 16 | val conv : 17 | ?docv:string -> (string -> 'a result) -> (Format.formatter -> 'a -> unit) -> 18 | 'a conv 19 | 20 | val conv_with_docv : 'a conv -> docv:string -> 'a conv 21 | val conv_parser : 'a conv -> (string -> 'a result) 22 | val conv_printer : 'a conv -> (Format.formatter -> 'a -> unit) 23 | val conv_docv : 'a conv -> string 24 | 25 | val bool : bool conv 26 | val int : int conv 27 | val string : string conv 28 | val fpath : Topkg_fpath.t conv 29 | val some : ?none:string -> 'a conv -> 'a option conv 30 | 31 | (** {1 Configuration keys} *) 32 | 33 | type 'a key 34 | 35 | val key : 36 | ?docv:string -> ?doc:string -> ?env:string -> string -> 'a conv -> 37 | absent:'a -> 'a key 38 | 39 | val discovered_key : 40 | ?docv:string -> ?doc:string -> ?env:string -> string -> 'a conv -> 41 | absent:(unit -> 'a result) -> 'a key 42 | 43 | val with_pkg : ?default:bool -> string -> bool key 44 | 45 | val pp_keys_cli_opts : Format.formatter -> unit -> unit 46 | 47 | (** {1 Build configuration} *) 48 | 49 | type t 50 | val empty : t 51 | val value : t -> 'a key -> 'a 52 | val pp_value : t -> Format.formatter -> 'a key -> unit 53 | val dump : Format.formatter -> t -> unit 54 | val of_cli_args : 55 | pkg_name:string -> build_dir:Topkg_fpath.t -> string list -> t result 56 | 57 | val pkg_name : t -> string 58 | val build_dir : t -> Topkg_fpath.t 59 | val vcs : t -> bool 60 | val pinned : t -> bool 61 | val dev_pkg : t -> bool 62 | val jobs : t -> int 63 | 64 | type build_context = [`Dev | `Distrib | `Pin ] 65 | val build_context : t -> [`Dev | `Distrib | `Pin ] 66 | val build_tests : t -> bool 67 | 68 | val debug : t -> bool 69 | val debugger_support : t -> bool 70 | val profile : t -> bool 71 | val toolchain : t -> string option 72 | 73 | (** {1 Tool lookup} *) 74 | 75 | type os = [ `Build_os | `Host_os ] 76 | val tool : ?conf:t -> string -> os -> Topkg_cmd.t 77 | 78 | (** {1 OCaml configuration} *) 79 | 80 | module OCaml : sig 81 | type conf = t 82 | type t 83 | val v : conf -> os -> t 84 | val find : string -> t -> string option 85 | val version : t -> int * int * int * string option 86 | val ext_obj : t -> string 87 | val ext_asm : t -> string 88 | val ext_lib : t -> string 89 | val ext_dll : t -> string 90 | val ext_exe : t -> string 91 | val native : t -> bool 92 | val native_dynlink : t -> bool 93 | val supports_shared_libraries : t -> bool 94 | val word_size : t -> int 95 | val dump : Format.formatter -> t -> unit 96 | end 97 | -------------------------------------------------------------------------------- /src-bin/cli.mli: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (** {!Cmdliner} and common definitions for commands. *) 7 | 8 | open Cmdliner 9 | open Rresult 10 | 11 | (** {1 Converters and options} *) 12 | 13 | val path_arg : Fpath.t Arg.conv 14 | (** [path_arg] is a path argument converter. *) 15 | 16 | val pkg_file : Fpath.t Term.t 17 | (** A [--pkg-file] option to specify the package description file to use. *) 18 | 19 | val pkg_name : string option Term.t 20 | (** A [--pkg-name] option to specify the opam package name. *) 21 | 22 | val opam : Fpath.t option Term.t 23 | (** An [--opam] option for defining an opam file. *) 24 | 25 | val dist_name : string option Term.t 26 | (** A [--dist-name] option to define the package name of the distribution. *) 27 | 28 | val dist_version : string option Term.t 29 | (** A [--dist-version] option to define the package version. *) 30 | 31 | val dist_file : Fpath.t option Term.t 32 | (** A [--dist-file] option to define the distribution archive file. *) 33 | 34 | val dist_uri : string option Term.t 35 | (** A [--dist-uri] option to define the distribution archive URI on the WWW. *) 36 | 37 | val dist_opam : Fpath.t option Term.t 38 | (** An [--dist-opam] option to define the opam file. *) 39 | 40 | val readme : Fpath.t option Term.t 41 | (** A [--readme] option to define the readme. *) 42 | 43 | val change_log : Fpath.t option Term.t 44 | (** A [--change-log] option to define the change log. *) 45 | 46 | val opam : Fpath.t option Term.t 47 | (** An [--opam] option to define an opam file. *) 48 | 49 | val delegate : Bos.Cmd.t option Term.t 50 | (** A [--delegate] option to define the delegate. *) 51 | 52 | val build_dir : Fpath.t option Term.t 53 | (** A [--build-dir] option to define the build directory. *) 54 | 55 | val publish_msg : string option Term.t 56 | (** A [--msg] option to define a publication message. *) 57 | 58 | (** {1 Terms} *) 59 | 60 | val setup : unit Term.t 61 | (** [setup env] defines a basic setup common to all commands. The 62 | setup does, by side effect, set {!Logs} log verbosity, adjusts 63 | colored output and sets the current working directory. *) 64 | 65 | (** {1 Verbosity propagation} *) 66 | 67 | val propagate_verbosity_to_pkg_file : unit -> Bos.Cmd.t 68 | (** [propagate_verbosity_to_pkg_file ()] is 69 | a command line fragment that has the option to propagate 70 | the current log verbosity to an invocation of the package 71 | description. *) 72 | 73 | (** {1 Warnings and errors} *) 74 | 75 | val warn_if_vcs_dirty : string -> (unit, R.msg) result 76 | (** [warn_if_vcs_dirty msg] warns with [msg] if the VCS is dirty. *) 77 | 78 | val handle_error : (int, R.msg) result -> int 79 | (** [handle_error r] is [r]'s result or logs [r]'s error and returns [3]. *) 80 | 81 | val exits : Cmd.Exit.info list 82 | (** [exits] is are the exit codes common to all commands. *) 83 | -------------------------------------------------------------------------------- /src/topkg_ipc.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Topkg_result 7 | 8 | type 'a t = 9 | { cmd : Topkg_cmd.t; 10 | codec : 'a Topkg_codec.t; 11 | answer : Topkg_fpath.t; } 12 | 13 | let v ?answer cmd codec = 14 | let answer = match answer with 15 | | Some a -> a 16 | | None -> 17 | (Topkg_os.File.tmp ()) 18 | |> R.reword_error_msg ~replace:true 19 | (fun m -> R.msgf "Could not create IPC answer file: %s, using stdout" m) 20 | |> Topkg_log.on_error_msg ~use:(fun () -> Topkg_os.File.dash) 21 | in 22 | let cmd = Topkg_cmd.(v answer %% cmd) in 23 | { cmd; codec; answer } 24 | 25 | let cmd ipc = ipc.cmd 26 | let codec ipc = ipc.codec 27 | let answer ipc = ipc.answer 28 | 29 | let error_args args = 30 | R.error_msgf "IPC: %a, unknown arguments" 31 | Topkg_cmd.dump (Topkg_cmd.of_list args) 32 | 33 | (* Package description IPC. Description functions raise Invalid_argument 34 | at the other end. *) 35 | 36 | let pkg () = v Topkg_cmd.(v "pkg") Topkg_pkg.codec 37 | let answer_pkg answer p = Topkg_codec.write answer Topkg_pkg.codec p 38 | 39 | (* Run custom lint IPC *) 40 | 41 | let lint_custom_codec = Topkg_codec.(option @@ list @@ result_error_msg @@ msg) 42 | let lint_custom () = 43 | let cmd = Topkg_cmd.(v "lint" % "custom") in 44 | v cmd lint_custom_codec 45 | 46 | let answer_lint_custom answer p = 47 | let custom_run = match (Topkg_pkg.lint_custom p) with 48 | | None -> None 49 | | Some custom -> Some (custom ()) 50 | in 51 | Topkg_codec.write answer lint_custom_codec custom_run 52 | 53 | (* Distrib prepare IPC *) 54 | 55 | let distrib_prepared_codec = 56 | Topkg_codec.version 0 @@ 57 | Topkg_codec.(with_kind "prepared" @@ result_error_msg (list fpath)) 58 | 59 | let distrib_prepare ~dist_build_dir ~name ~version ~opam ~opam_adds = 60 | let cmd = 61 | Topkg_cmd.(v "distrib" % "prepare" % 62 | "dist-build-dir" % dist_build_dir % "name" % name % 63 | "version" % version % "opam" % opam % "opam-adds" % opam_adds) 64 | in 65 | v cmd distrib_prepared_codec 66 | 67 | let answer_distrib_prepare 68 | answer p ~dist_build_dir ~name ~version ~opam ~opam_adds 69 | = 70 | Topkg_codec.write answer distrib_prepared_codec @@ 71 | Topkg_pkg.distrib_prepare p ~dist_build_dir ~name ~version ~opam ~opam_adds 72 | 73 | (* IPC answer *) 74 | 75 | let write_answer cmd p = match Topkg_cmd.to_list cmd with 76 | | answer :: "pkg" :: [] -> 77 | answer_pkg answer p 78 | | answer :: "lint" :: "custom" :: [] -> 79 | answer_lint_custom answer p 80 | | answer :: "distrib" :: "prepare" :: 81 | "dist-build-dir" :: dist_build_dir :: "name" :: name :: 82 | "version" :: version :: "opam" :: opam :: "opam-adds" :: opam_adds :: [] -> 83 | answer_distrib_prepare 84 | answer p ~dist_build_dir ~name ~version ~opam ~opam_adds 85 | 86 | | args -> 87 | error_args args 88 | -------------------------------------------------------------------------------- /src/topkg_log.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Topkg_result 7 | 8 | type level = App | Error | Warning | Info | Debug 9 | 10 | let exec = match Array.length Sys.argv with 11 | | 0 -> Filename.basename Sys.executable_name 12 | | n -> Filename.basename Sys.argv.(0) 13 | 14 | let _level = 15 | let default = Some Warning in 16 | let init = 17 | try match Sys.getenv "TOPKG_VERBOSITY" with 18 | | l when Topkg_string.is_prefix ~affix:"quiet" l -> None 19 | | l when Topkg_string.is_prefix ~affix:"error" l -> Some Error 20 | | l when Topkg_string.is_prefix ~affix:"warning" l -> Some Warning 21 | | l when Topkg_string.is_prefix ~affix:"info" l -> Some Info 22 | | l when Topkg_string.is_prefix ~affix:"debug" l -> Some Debug 23 | | l -> 24 | Format.eprintf 25 | "%s: @[TOPKG_VERBOSITY env var unknown value: %S@]@." exec l; 26 | default 27 | with Not_found | Sys_error _ -> default 28 | in 29 | ref init 30 | 31 | let level () = !_level 32 | let set_level l = _level := l 33 | 34 | let level_to_string = function 35 | | None -> "quiet" | Some App -> "app" | Some Error -> "error" 36 | | Some Warning -> "warning" | Some Info -> "info" | Some Debug -> "debug" 37 | 38 | let level_of_string = function 39 | | "quiet" -> Ok None 40 | | "app" -> Ok (Some App) 41 | | "error" -> Ok (Some Error) 42 | | "warning" -> Ok (Some Warning) 43 | | "info" -> Ok (Some Info) 44 | | "debug" -> Ok (Some Debug) 45 | | l -> R.error_msgf "%S: unknown log level" l 46 | 47 | type 'a msgf = 48 | (?header:string -> ('a, Format.formatter, unit) format -> 'a) -> unit 49 | 50 | let _err_count = ref 0 51 | let err_count () = !_err_count 52 | 53 | let _warn_count = ref 0 54 | let warn_count () = !_warn_count 55 | 56 | let pp_level_header ppf (h,l) = match h with 57 | | Some h -> Format.fprintf ppf "[%s] " h 58 | | None -> 59 | Format.pp_print_string ppf begin match l with 60 | | App -> "" 61 | | Error -> "[ERROR] " 62 | | Warning -> "[WARNING] " 63 | | Info -> "[INFO] " 64 | | Debug -> "[DEBUG] " 65 | end 66 | 67 | let msg level msgf = match !_level with 68 | | None -> () 69 | | Some level' when level > level' -> 70 | if level = Error then incr _err_count else 71 | if level = Warning then incr _warn_count else () 72 | | Some _ -> 73 | (if level = Error then incr _err_count else 74 | if level = Warning then incr _warn_count else ()); 75 | let pr = if level = App then Format.printf else Format.eprintf in 76 | msgf @@ 77 | (fun ?header fmt -> 78 | pr ("%s: %a@[" ^^ fmt ^^ "@]@.") exec pp_level_header (header, level)) 79 | 80 | let app msgf = msg App msgf 81 | let err msgf = msg Error msgf 82 | let warn msgf = msg Warning msgf 83 | let info msgf = msg Info msgf 84 | let debug msgf = msg Debug msgf 85 | 86 | let on_error_msg ?(level = Error) ~use = function 87 | | Ok v -> v 88 | | Error (`Msg e) -> msg level (fun m -> m "%s" e); use () 89 | -------------------------------------------------------------------------------- /src/topkg.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | (* Preliminaries *) 7 | 8 | include Topkg_result 9 | 10 | let strf = Topkg_string.strf 11 | module String = Topkg_string 12 | 13 | type fpath = string 14 | module Fpath = Topkg_fpath 15 | 16 | module Cmd = Topkg_cmd 17 | module Log = Topkg_log 18 | module OS = Topkg_os 19 | module Vcs = Topkg_vcs 20 | 21 | (* Package description *) 22 | 23 | module Conf = Topkg_conf 24 | module Exts = Topkg_fexts 25 | module Pkg = struct 26 | 27 | (* Install *) 28 | 29 | type install = Topkg_install.t 30 | type field = Topkg_install.field 31 | type exec_field = ?auto:bool -> field 32 | 33 | let nothing = Topkg_install.nothing 34 | let flatten = Topkg_install.flatten 35 | let bin = Topkg_install.bin 36 | let doc = Topkg_install.doc 37 | let etc = Topkg_install.etc 38 | let lib = Topkg_install.lib 39 | let lib_root = Topkg_install.lib_root 40 | let libexec = Topkg_install.libexec 41 | let libexec_root = Topkg_install.libexec_root 42 | let man = Topkg_install.man 43 | let misc = Topkg_install.misc 44 | let sbin = Topkg_install.sbin 45 | let share = Topkg_install.share 46 | let share_root = Topkg_install.share_root 47 | let stublibs = Topkg_install.stublibs 48 | let toplevel = Topkg_install.toplevel 49 | let unknown = Topkg_install.unknown 50 | let test = Topkg_install.test 51 | 52 | let mllib = Topkg_install.mllib 53 | let clib = Topkg_install.clib 54 | 55 | (* Distrib *) 56 | 57 | type watermark = Topkg_distrib.watermark 58 | type distrib = Topkg_distrib.t 59 | 60 | let distrib = Topkg_distrib.v 61 | let watermarks = Topkg_distrib.default_watermarks 62 | let files_to_watermark = Topkg_distrib.default_files_to_watermark 63 | let massage = Topkg_distrib.default_massage 64 | let exclude_paths = Topkg_distrib.default_exclude_paths 65 | 66 | (* Publish *) 67 | 68 | type publish = Topkg_publish.t 69 | let publish = Topkg_publish.v 70 | 71 | (* Build *) 72 | 73 | type build = Topkg_build.t 74 | let build = Topkg_build.v 75 | let build_cmd = Topkg_build.build_cmd 76 | let clean_cmd = Topkg_build.clean_cmd 77 | let ocb_tag = Topkg_build.ocb_tag 78 | let ocb_bool_tag = Topkg_build.ocb_bool_tag 79 | let ocb_bool_tags = Topkg_build.ocb_bool_tags 80 | 81 | (* Package *) 82 | 83 | type std_file = Topkg_pkg.std_file 84 | let std_file = Topkg_pkg.std_file 85 | 86 | type meta_file = Topkg_pkg.meta_file 87 | let meta_file = Topkg_pkg.meta_file 88 | 89 | type opam_file = Topkg_pkg.opam_file 90 | let opam_file = Topkg_pkg.opam_file 91 | 92 | (* Describe *) 93 | 94 | let describe = Topkg_main.describe 95 | end 96 | 97 | module Private = struct 98 | let disable_main = Topkg_main.disable 99 | module Codec = Topkg_codec 100 | module Pkg = Topkg_pkg 101 | module Ipc = Topkg_ipc 102 | module Opam = Topkg_opam 103 | end 104 | -------------------------------------------------------------------------------- /src-bin/tag.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Bos_setup 7 | 8 | let extract_version change_log = 9 | Topkg_care.Text.change_log_file_last_entry change_log 10 | >>= fun (version, _) -> Ok version 11 | 12 | let vcs_tag tag ~commit_ish ~force ~sign ~delete ~msg = 13 | let msg = match msg with None -> strf "Distribution %s" tag | Some m -> m in 14 | Topkg.Vcs.get () 15 | >>= fun repo -> match delete with 16 | | true -> Topkg.Vcs.delete_tag repo tag 17 | | false -> 18 | Topkg.Vcs.tag repo ~force ~sign ~msg ~commit_ish tag >>| fun () -> 19 | Logs.app (fun m -> m "Tagged version %a" Topkg_care.Pp.version tag) 20 | 21 | let tag () pkg_file change_log tag commit_ish force sign delete msg = 22 | begin 23 | let pkg = Topkg_care.Pkg.v ?change_log pkg_file in 24 | let tag = match tag with 25 | | Some t -> Ok t 26 | | None -> Topkg_care.Pkg.change_log pkg >>= fun cl -> extract_version cl 27 | in 28 | tag 29 | >>= fun tag -> vcs_tag tag ~commit_ish ~force ~sign ~delete ~msg 30 | >>= fun () -> Ok 0 31 | end 32 | |> Cli.handle_error 33 | 34 | (* Command line interface *) 35 | 36 | open Cmdliner 37 | 38 | let version = 39 | let doc = "The version tag to use. If absent, automatically extracted 40 | from the package's change log; see topkg-log(1) for details." 41 | in 42 | Arg.(value & pos 0 (some string) None & info [] ~doc ~docv:"VERSION") 43 | 44 | let commit = 45 | let doc = "Commit-ish $(docv) to tag." in 46 | Arg.(value & opt string "HEAD" & info ["commit"] ~doc ~docv:"COMMIT-ISH") 47 | 48 | let msg = 49 | let doc = "Commit message for the tag. If absent, the message 50 | 'Distribution $(i,VERSION)' is used." 51 | in 52 | Arg.(value & opt (some string) None & info ["m"; "message"] ~doc ~docv:"MSG") 53 | 54 | let sign = 55 | let doc = "Sign the tag using the VCS's default signing key." in 56 | Arg.(value & flag & info ["s"; "sign"] ~doc) 57 | 58 | let force = 59 | let doc = "If the tag exists, replace it rather than fail." in 60 | Arg.(value & flag & info ["f"; "force"] ~doc) 61 | 62 | let delete = 63 | let doc = "Delete the specified tag rather than create it." in 64 | Arg.(value & flag & info ["d"; "delete"] ~doc) 65 | 66 | let doc = "Tag the package's source repository with a version" 67 | let sdocs = Manpage.s_common_options 68 | let exits = Cli.exits 69 | let man_xrefs = [ `Main; `Cmd "log" ] 70 | let man = 71 | [ `S Manpage.s_description; 72 | `P "The $(tname) command tags the package's VCS HEAD commit with a 73 | version. If the version is not specified on the command line it is 74 | automatically extracted from the package's change log; use 75 | $(b,topkg log -t) to check the extracted value." ] 76 | 77 | let cmd = 78 | Cmd.v (Cmd.info "tag" ~doc ~sdocs ~exits ~man ~man_xrefs) @@ 79 | Term.(const tag $ Cli.setup $ Cli.pkg_file $ Cli.change_log $ 80 | version $ commit $ force $ sign $ delete $ msg) 81 | -------------------------------------------------------------------------------- /src-bin/status.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Bos_setup 7 | 8 | let pp_since ppf = function 9 | | "" -> () 10 | | v -> Fmt.pf ppf " since %a" Topkg_care.Pp.version v 11 | 12 | let pp_dirty ppf = function 13 | | false -> () 14 | | true -> Fmt.pf ppf "The repository is %a.@," Topkg_care.Pp.dirty () 15 | 16 | let pp_commit ppf (id, log) = 17 | Fmt.pf ppf "%a %s" Topkg_care.Pp.commit id log 18 | 19 | let pp_status ppf (dirty, version, changes) = match changes with 20 | | [] when not dirty -> Fmt.pf ppf "@[No changes%a@]" pp_since version 21 | | changes -> 22 | Fmt.pf ppf "@[Changes%a:@,%a%a@]" 23 | pp_since version pp_dirty dirty (Fmt.list pp_commit) changes 24 | 25 | let find_latest_version_tag repo = 26 | let rev_compare v v' = -1 * compare v v' in 27 | let parse_tag acc t = match Topkg.String.parse_version t with 28 | | None -> acc 29 | | Some v -> (v, t) :: acc 30 | in 31 | Topkg.Vcs.tags repo >>| fun tags -> 32 | match List.(sort rev_compare (fold_left parse_tag [] tags)) with 33 | | (_, latest) :: _ -> Some latest 34 | | [] -> None 35 | 36 | let find_after repo = function 37 | | Some after -> Ok after 38 | | None -> 39 | find_latest_version_tag repo >>| function 40 | | None -> 41 | Logs.info (fun m -> m "No VCS version tag found."); "" 42 | | Some tag -> 43 | Logs.info (fun m -> m "Latest VCS version tag found: %s" tag); tag 44 | 45 | let status () _ after until = 46 | begin 47 | Topkg.Vcs.get () 48 | >>= fun repo -> Topkg.Vcs.is_dirty repo 49 | >>= fun dirty -> find_after repo after 50 | >>= fun after -> Topkg.Vcs.changes repo ~after ~until 51 | >>= fun changes -> 52 | Logs.app (fun m -> m "%a" pp_status (dirty, after, changes)); 53 | Ok (if dirty || changes <> [] then 0 else 1) 54 | end 55 | |> Cli.handle_error 56 | 57 | (* Command line interface *) 58 | 59 | open Cmdliner 60 | 61 | let after = 62 | let doc = "Commit-ish $(docv) after which commits are considered. 63 | Default is the latest VCS version tag of the form [v]X.Y.Z[+info]." 64 | in 65 | Arg.(value & opt (some string) None & info ["after"] ~doc ~docv:"COMMIT-ISH") 66 | 67 | let until = 68 | let doc = "Commit-ish $(docv) until which commits are considered." in 69 | let docv = "COMMIT-ISH" in 70 | Arg.(value & opt string "HEAD" & info ["until"] ~doc ~docv) 71 | 72 | let doc = "List commits to publish in the next distribution" 73 | let sdocs = Manpage.s_common_options 74 | let exits = 75 | (Cmd.Exit.info 0 ~doc:"changes have been detected.") :: 76 | (Cmd.Exit.info 1 ~doc:"no changes have been detected.") :: 77 | Cmd.Exit.defaults 78 | 79 | let man_xrefs = [ `Main ] 80 | let man = 81 | [ `S Manpage.s_description; 82 | `P "The $(tname) command consults the package's VCS and outputs the 83 | list of commits that define the changes for the next distribution." ] 84 | 85 | let cmd = 86 | Cmd.v (Cmd.info "status" ~doc ~sdocs ~exits ~man ~man_xrefs) @@ 87 | Term.(const status $ Cli.setup $ Cli.pkg_file $ after $ until) 88 | -------------------------------------------------------------------------------- /src/topkg_build.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Topkg_result 7 | 8 | let ocamlbuild_flags = 9 | Topkg_cmd.(empty % "-use-ocamlfind" % "-classic-display") 10 | 11 | let build_cmd c os = 12 | let ocamlbuild = Topkg_conf.tool "ocamlbuild" os in 13 | let build_dir = Topkg_conf.build_dir c in 14 | let toolchain = 15 | match Topkg_conf.toolchain c with 16 | | Some toolchain -> Topkg_cmd.(v "-toolchain" % toolchain) 17 | | _ -> Topkg_cmd.empty 18 | in 19 | let debug = Topkg_cmd.(on (Topkg_conf.debug c) (v "-tag" % "debug")) in 20 | let profile = Topkg_cmd.(on (Topkg_conf.profile c) (v "-tag" % "profile")) in 21 | let jobs = 22 | let n = Topkg_conf.jobs c in 23 | Topkg_log.info (fun m -> m "using %d jobs" n); 24 | Topkg_cmd.(on (n != 1) (v "-j" % string_of_int n)) in 25 | Topkg_cmd.(ocamlbuild %% ocamlbuild_flags %% toolchain %% jobs %% 26 | debug %% profile % "-build-dir" % build_dir) 27 | 28 | let clean_cmd os ~build_dir = 29 | let ocamlbuild = Topkg_conf.tool "ocamlbuild" os in 30 | Topkg_cmd.(ocamlbuild %% ocamlbuild_flags % 31 | "-build-dir" % build_dir % "-clean") 32 | 33 | type t = 34 | { prepare_on_pin : bool; 35 | dir : Topkg_fpath.t; 36 | pre : Topkg_conf.t -> unit result; 37 | cmd : Topkg_conf.t -> Topkg_conf.os -> Topkg_fpath.t list -> unit result; 38 | post : Topkg_conf.t -> unit result; 39 | clean : Topkg_conf.os -> build_dir:Topkg_fpath.t -> unit result; } 40 | 41 | let with_dir b dir = { b with dir } 42 | 43 | let nop = fun _ -> Ok () 44 | 45 | let cmd c os files = 46 | let targets = String.concat "\n" files in 47 | Topkg_os.File.write "pkg.itarget" targets >>= fun () -> 48 | Topkg_os.Cmd.run @@ Topkg_cmd.(build_cmd c os % "pkg.otarget") 49 | 50 | let clean os ~build_dir = 51 | Topkg_os.Cmd.run @@ clean_cmd os ~build_dir 52 | 53 | let v 54 | ?(prepare_on_pin = true) ?(dir = "_build") ?(pre = nop) ?(cmd = cmd) 55 | ?(post = nop) ?(clean = clean) () = 56 | { prepare_on_pin; dir; pre; cmd; post; clean; } 57 | 58 | let prepare_on_pin b = b.prepare_on_pin 59 | let dir b = b.dir 60 | let pre b = b.pre 61 | let cmd b = b.cmd 62 | let post b = b.post 63 | let clean b = b.clean 64 | let codec = 65 | let prepare_on_pin = Topkg_codec.(with_kind "prepare_on_pin" @@ bool) in 66 | let dir = Topkg_codec.(with_kind "dir" @@ string) in 67 | let fields = 68 | let stub _ = invalid_arg "not executable outside package definition" in 69 | (fun b -> b.prepare_on_pin, b.dir), 70 | (fun (prepare_on_pin, dir) -> 71 | { prepare_on_pin; dir; pre = stub; cmd = stub; post = stub; 72 | clean = stub }) 73 | in 74 | Topkg_codec.version 0 @@ 75 | Topkg_codec.(view ~kind:"build" fields (pair prepare_on_pin dir)) 76 | 77 | let ocb_tag c key tag = 78 | let tag = Topkg_string.strf "%s(%a)" tag (Topkg_conf.pp_value c) key in 79 | Topkg_cmd.(v "-tag" % tag) 80 | 81 | let ocb_bool_tag c key tag = 82 | Topkg_cmd.(on (Topkg_conf.value c key) @@ v "-tag" % tag) 83 | 84 | let ocb_bool_tags c tags = 85 | let f (key, tag) = Topkg_cmd.(%%) (ocb_bool_tag c key tag) in 86 | List.fold_right f tags Topkg_cmd.empty 87 | -------------------------------------------------------------------------------- /src-bin/test.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Bos_setup 7 | 8 | let test_args name build_dir list args = 9 | let on_some_use_opt opt to_arg = function 10 | | None -> Cmd.empty 11 | | Some value -> Cmd.(v opt % to_arg value) 12 | in 13 | let verb = Cli.propagate_verbosity_to_pkg_file () in 14 | let build_dir = on_some_use_opt "--build-dir" Cmd.p build_dir in 15 | let list = if list then Cmd.(v "--list") else Cmd.empty in 16 | let name = on_some_use_opt "--pkg-name" (fun n -> n) name in 17 | Cmd.(verb %% name %% list %% build_dir %% Cmd.of_list args) 18 | 19 | let test () pkg_file pkg_name build_dir list args = 20 | let pkg = Topkg_care.Pkg.v pkg_file in 21 | let args = test_args pkg_name build_dir list args in 22 | let out = OS.Cmd.out_stdout in 23 | begin 24 | OS.Dir.current () 25 | >>= fun dir -> Topkg_care.Pkg.test pkg ~dir ~args ~out 26 | >>| (function ((), (_, `Exited 0)) -> 0 | _ -> 1) 27 | end 28 | |> Cli.handle_error 29 | 30 | (* Command line interface *) 31 | 32 | open Cmdliner 33 | 34 | let args = 35 | let doc = "Tests and arguments to the tests. If options are being 36 | passed, needs to be specified after a -- token so that the 37 | command line options do not get interpreted by $(b,topkg test) 38 | itself. If arguments need to be specified for the test itself a 39 | second -- token is needed." 40 | in 41 | Arg.(value & pos_all string [] & info [] ~doc ~docv:"[TEST]... [-- ARG...]") 42 | 43 | let build_dir = 44 | let doc = "Specifies the build directory $(docv). If absent, provided 45 | by the package description. This is equivalent to specify 46 | the same option after the first -- token" 47 | in 48 | let docv = "BUILD_DIR" in 49 | Arg.(value & opt (some Cli.path_arg) None & info ["build-dir"] ~doc ~docv) 50 | 51 | let list = 52 | let doc = "Do not run the tests, list them. This is equivalent to 53 | specify the same option after the first -- token." 54 | in 55 | Arg.(value & flag & info ["l"; "list"] ~doc) 56 | 57 | let doc = "Run built package tests" 58 | let sdocs = Manpage.s_common_options 59 | let exits = Cmd.Exit.info 1 ~doc:"on test failure." :: Cli.exits 60 | let man_xrefs = [ `Main ] 61 | let man = 62 | [ `S Manpage.s_synopsis; 63 | `P "$(mname) $(tname) [$(i,OPTION)]... [-- [$(i,TEST)]... \ 64 | [-- [$(i,ARG)]...]]"; 65 | `S Manpage.s_description; 66 | `P "The $(tname) command runs the tests that were built by 67 | topkg-build(1). This is equivalent to invoke:"; 68 | `Pre "ocaml ./pkg/pkg.ml test [$(i,TEST)]... [-- [$(i,ARG)]...]"; 69 | `P "The value for $(i,TEST) can be a full path to the test executable 70 | or simply the basename of the test executable with or without the file 71 | extension. The option $(b,--list) lists the tests that were built."; 72 | `P "Note that if you want to pass command line arguments to a test you 73 | need to specify the token -- twice. For example to pass 'arg' to a 74 | test 'mytest' use one of the following invocation:"; 75 | `Pre "topkg test -- mytest -- arg"; `Noblank; 76 | `Pre "topkg test mytest -- -- arg" ] 77 | 78 | let cmd = 79 | Cmd.v (Cmd.info "test" ~doc ~sdocs ~exits ~man ~man_xrefs) @@ 80 | Term.(const test $ Cli.setup $ Cli.pkg_file $ Cli.pkg_name $ build_dir $ 81 | list $ args) 82 | -------------------------------------------------------------------------------- /B0.ml: -------------------------------------------------------------------------------- 1 | open B0_kit.V000 2 | open Result.Syntax 3 | 4 | (* Note we have much more deps than in ocamlbuild here because we don't do 5 | transitive -I. *) 6 | 7 | let opam_core = B0_ocaml.libname "opam-core" 8 | let opam_format = B0_ocaml.libname "opam-format" 9 | let cmdliner = B0_ocaml.libname "cmdliner" 10 | let rresult = B0_ocaml.libname "rresult" 11 | let astring = B0_ocaml.libname "astring" 12 | let fpath = B0_ocaml.libname "fpath" 13 | let fmt = B0_ocaml.libname "fmt" 14 | let fmt_tty = B0_ocaml.libname "fmt.tty" 15 | let fmt_cli = B0_ocaml.libname "fmt.cli" 16 | let logs = B0_ocaml.libname "logs" 17 | let logs_fmt = B0_ocaml.libname "logs.fmt" 18 | let logs_cli = B0_ocaml.libname "logs.cli" 19 | let bos_setup = B0_ocaml.libname "bos.setup" 20 | let webbrowser = B0_ocaml.libname "webbrowser" 21 | let webbrowser_cli = B0_ocaml.libname "webbrowser.cli" 22 | 23 | let topkg = B0_ocaml.libname "topkg" 24 | let topkg_care = B0_ocaml.libname "topkg.care" 25 | 26 | (* Libraries *) 27 | 28 | let topkg_lib = 29 | B0_ocaml.lib topkg ~name:"topkg-lib" ~srcs:[`Dir ~/"src"] 30 | 31 | let care_requires requires = 32 | opam_core :: opam_format:: cmdliner:: rresult :: astring :: fpath :: fmt :: 33 | fmt_tty :: fmt_cli :: logs :: logs_fmt :: logs_cli:: bos_setup :: 34 | webbrowser :: webbrowser_cli :: topkg :: requires 35 | 36 | let topkg_care_lib = 37 | let srcs = [`Dir ~/"src-care"] in 38 | B0_ocaml.lib topkg_care ~srcs ~requires:(care_requires []) 39 | 40 | (* Tools *) 41 | 42 | let topkg_tool = 43 | let srcs = [`Dir ~/"src-bin"; `X ~/"src-bin/toy_github_delegate.ml" ] in 44 | B0_ocaml.exe ~public:true "topkg" ~srcs ~requires:(care_requires [topkg_care]) 45 | 46 | let toy_github_delegate = 47 | let srcs = [`File ~/"src-bin/toy_github_delegate.ml"] in 48 | let requires = [cmdliner; fpath; rresult; fmt_tty; astring; bos_setup; topkg; 49 | topkg_care] 50 | in 51 | B0_ocaml.exe ~public:true "toy-github-topkg-delegate" ~srcs ~requires 52 | 53 | 54 | (* Packs *) 55 | 56 | let base_metadata = 57 | B0_meta.empty 58 | |> ~~ B0_meta.authors ["The topkg programmers"] 59 | |> ~~ B0_meta.maintainers ["Daniel Bünzli "] 60 | |> ~~ B0_meta.homepage "https://erratique.ch/software/topkg" 61 | |> ~~ B0_meta.online_doc "https://erratique.ch/software/topkg/doc" 62 | |> ~~ B0_meta.licenses ["ISC"] 63 | |> ~~ B0_meta.repo "git+https://erratique.ch/repos/topkg.git" 64 | |> ~~ B0_meta.issues "https://github.com/dbuenzli/topkg/issues" 65 | |> ~~ B0_meta.description_tags ["packaging"; "ocamlbuild"; "org:erratique"] 66 | |> B0_meta.tag B0_opam.tag 67 | |> ~~ B0_opam.build 68 | {|[["ocaml" "pkg/pkg.ml" "build" "--pkg-name" name 69 | "--dev-pkg" "%{dev}%"]]|} 70 | let topkg = 71 | let meta = 72 | base_metadata 73 | |> ~~ B0_opam.depends 74 | [ "ocaml", {|>= "4.08.0"|}; 75 | "ocamlfind", {|build & >= "1.6.1"|}; 76 | "ocamlbuild", ""; ] 77 | in 78 | B0_pack.make "topkg" ~doc:"topkg package" ~meta ~locked:true [] 79 | 80 | let topkg_care = 81 | let meta = 82 | base_metadata 83 | |> ~~ B0_release.src_archive_name (B0_pack.basename topkg) 84 | |> ~~ B0_opam.depends 85 | [ "ocaml", {|>= "4.08.0"|}; 86 | "ocamlfind", {|build & >= "1.6.1"|}; 87 | "ocamlbuild", ""; 88 | "topkg", {|= version|}; 89 | "fmt", {|>= "0.9.0"|}; 90 | "logs", ""; 91 | "bos", {|>= "0.2.1"|}; 92 | "cmdliner", {|>= "1.3.0"|}; 93 | "webbrowser", ""; 94 | "opam-format", {|>= "2.0.0"|}; 95 | ] 96 | in 97 | B0_pack.make "topkg-care" ~doc:"topkg-care package" ~meta ~locked:true [] 98 | -------------------------------------------------------------------------------- /src/topkg_opam.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Topkg_result 7 | 8 | (* opam File *) 9 | 10 | module File = struct 11 | type t = (string * string list) list 12 | 13 | let codec = 14 | Topkg_codec.version 0 @@ 15 | Topkg_codec.with_kind "opam fields" @@ 16 | Topkg_codec.(list (pair string (list string))) 17 | 18 | let topkg_cmd = Topkg_cmd.v "topkg" 19 | let topkg_cmd_available () = 20 | Topkg_os.Cmd.must_exist topkg_cmd 21 | |> R.reword_error_msg ~replace:true 22 | (fun m -> R.msgf "%s. Did you install topkg-care ?" m) 23 | 24 | let ipc_cmd file = 25 | (* Propagate the log level to the IPC call *) 26 | let level = Topkg_log.(level_to_string (level ())) in 27 | let verbosity = Topkg_string.strf "--verbosity=%s" level in 28 | Topkg_cmd.(v "ipc" % verbosity % "opam-fields" % file) 29 | 30 | let fields file = 31 | begin 32 | let cmd = Topkg_cmd.(topkg_cmd %% ipc_cmd file) in 33 | topkg_cmd_available () 34 | >>= fun _ -> Topkg_os.File.must_exist file 35 | >>= fun _ -> Topkg_os.Cmd.(run_out cmd |> to_string) 36 | >>= fun s -> (Topkg_codec.dec_result codec s) 37 | end 38 | |> R.reword_error_msg ~replace:true 39 | (fun msg -> R.msgf "opam fields of %s: %s" file msg) 40 | end 41 | 42 | (* opam install file *) 43 | 44 | module Install = struct 45 | 46 | type field = 47 | [ `Bin 48 | | `Doc 49 | | `Etc 50 | | `Lib 51 | | `Lib_root 52 | | `Libexec 53 | | `Libexec_root 54 | | `Man 55 | | `Misc 56 | | `Sbin 57 | | `Share 58 | | `Share_root 59 | | `Stublibs 60 | | `Toplevel 61 | | `Unknown of string ] 62 | 63 | let field_to_string = function 64 | | `Bin -> "bin" 65 | | `Doc -> "doc" 66 | | `Etc -> "etc" 67 | | `Lib -> "lib" 68 | | `Lib_root -> "lib_root" 69 | | `Libexec -> "libexec" 70 | | `Libexec_root -> "libexec_root" 71 | | `Man -> "man" 72 | | `Misc -> "misc" 73 | | `Sbin -> "sbin" 74 | | `Share -> "share" 75 | | `Share_root -> "share_root" 76 | | `Stublibs -> "stublibs" 77 | | `Toplevel -> "toplevel" 78 | | `Unknown name -> name 79 | 80 | type move = { src : string; dst : string option; maybe : bool; } 81 | 82 | let move ?(maybe = false) ?dst src = { src; dst; maybe } 83 | 84 | type t = [ `Header of string option ] * (field * move) list 85 | 86 | let to_string (`Header h, mvs) = 87 | let b = Buffer.create 1024 in 88 | let pr b fmt = Printf.bprintf b fmt in 89 | let pr_header b = function None -> () | Some h -> pr b "# %s\n\n" h in 90 | let pr_src b src maybe = 91 | pr b " \"%s%s\"" (if maybe then "?" else "") src 92 | in 93 | let pr_dst b dst = match dst with 94 | | None -> () 95 | | Some dst -> pr b " {\"%s\"}" dst 96 | in 97 | let pr_field_end b last = if last <> "" (* not start *) then pr b " ]\n" in 98 | let pr_field b last field = 99 | if last = field then pr b "\n" else 100 | (pr_field_end b last; pr b "%s: [\n" field) 101 | in 102 | let pr_move b last (field, { src; dst; maybe }) = 103 | pr_field b last field; 104 | pr_src b src maybe; 105 | pr_dst b dst; 106 | field 107 | in 108 | let sortable (field, mv) = (field_to_string field, mv) in 109 | let moves = List.sort compare (List.rev_map sortable mvs) in 110 | pr_header b h; 111 | let last = List.fold_left (pr_move b) "" moves in 112 | pr_field_end b last; 113 | Buffer.contents b 114 | end 115 | -------------------------------------------------------------------------------- /src-bin/run.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Bos_setup 7 | 8 | let pp_exec = Fmt.(quote string) 9 | 10 | let blacklist = [ ".so"; ".cmxs" ] (* Don't try to run these kind of files *) 11 | 12 | let exec_match exec p = 13 | OS.File.exists p >>= function 14 | | false -> Ok false 15 | | true -> 16 | OS.Path.Mode.get p >>= fun mode -> 17 | if mode land 0o111 = 0 then Ok false else 18 | let p_base, ext = Fpath.split_ext p in 19 | let p_base = Fpath.to_string p_base in 20 | let p = Fpath.to_string p in 21 | Ok (not (List.mem ext blacklist) && 22 | (String.is_suffix ~affix:exec p_base || 23 | String.is_suffix ~affix:exec p)) 24 | 25 | let find_exec exec dir = 26 | let ambiguous l = 27 | R.error_msgf "Ambiguous matches for %a, could match any of %a" 28 | pp_exec exec Fmt.(list ~sep:(any ", ") Fpath.pp) l 29 | in 30 | OS.Dir.exists dir >>= function 31 | | false -> R.error_msgf "Build directory %a does not exist" Fpath.pp dir 32 | | true -> 33 | let elements = `Sat (exec_match exec) in 34 | OS.Dir.fold_contents ~elements (fun p ps -> p :: ps) [] dir 35 | >>= function 36 | | [p0] -> Ok p0 37 | | [p0; p1] as l -> 38 | let p0, ext0 = Fpath.split_ext p0 in 39 | let p1, ext1 = Fpath.split_ext p1 in 40 | if Fpath.equal p0 p1 && ext0 = ".native" || ext1 = ".native" 41 | then Ok (Fpath.add_ext ".native" p0) 42 | else ambiguous l 43 | | [] -> 44 | R.error_msgf "No matches for %a in build directory %a" 45 | Fmt.(quote string) exec Fpath.pp dir 46 | | l -> 47 | ambiguous l 48 | 49 | let run () pkg_file build_dir exec args = 50 | let pkg = Topkg_care.Pkg.v pkg_file ?build_dir in 51 | begin 52 | Topkg_care.Pkg.build_dir pkg 53 | >>= fun build_dir -> find_exec exec build_dir 54 | >>= fun exec -> Ok Cmd.(v (p exec) %% of_list args) 55 | >>= fun cmd -> OS.Cmd.run_status cmd 56 | >>= function 57 | | `Exited 0 -> Ok 0 58 | | status -> 59 | Logs.err (fun m -> m "run %a %a" 60 | Cmd.dump cmd OS.Cmd.pp_status status); 61 | Ok 1 62 | end 63 | |> Cli.handle_error 64 | 65 | (* Command line interface *) 66 | 67 | open Cmdliner 68 | 69 | let args = 70 | let doc = "Arguments given to the executable. If options are being 71 | passed, needs to be specified after a -- token so that the 72 | command line options do not get interpreted by the $(tname) 73 | command itself." 74 | in 75 | Arg.(value & pos_right 0 string [] & info [] ~doc ~docv:"ARG") 76 | 77 | let exec = 78 | let doc = "Executable name or path suffix, with or without its 79 | extension. If multiple executable match the specification 80 | the command errors except if two paths match and differ 81 | only by their .byte and .native file extension. In the latter 82 | case the .native path is used." 83 | in 84 | let docv = "EXEC" in 85 | Arg.(required & pos 0 (some string) None & info [] ~doc ~docv) 86 | 87 | let doc = "Run built executables" 88 | let sdocs = Manpage.s_common_options 89 | let exits = Cmd.Exit.info 1 ~doc:"on run non-zero status exit." :: Cli.exits 90 | let man_xrefs = [ `Main ] 91 | let man = 92 | [ `S Manpage.s_synopsis; 93 | `P "$(mname) $(tname) [$(i,OPTION)]... $(i,EXEC) \ 94 | [-- [$(i,ARG)]...]]"; 95 | `S Manpage.s_description; 96 | `P "The $(tname) command runs executable files found 97 | in the build directory."; 98 | `P "$(b,WARNING) The way this command works is subject to change 99 | in the future." ] 100 | 101 | let cmd = 102 | Cmd.v (Cmd.info "run" ~doc ~sdocs ~exits ~man ~man_xrefs) @@ 103 | Term.(const run $ Cli.setup $ Cli.pkg_file $ Cli.build_dir $ exec $ args) 104 | -------------------------------------------------------------------------------- /src-bin/build.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Bos_setup 7 | 8 | let build_args pkg_name build_dir dry_run raws tests debug args = 9 | let on_some_use_opt opt to_arg = function 10 | | None -> Cmd.empty 11 | | Some value -> Cmd.(v opt % to_arg value) 12 | in 13 | let verb = Cli.propagate_verbosity_to_pkg_file () in 14 | let pkg_name = on_some_use_opt "--pkg-name" (fun x -> x) pkg_name in 15 | let build_dir = on_some_use_opt "--build-dir" Cmd.p build_dir in 16 | let dry_run = if dry_run then Cmd.(v "--dry-run") else Cmd.empty in 17 | let raws = Cmd.of_list ~slip:"--raw" raws in 18 | let tests = on_some_use_opt "--tests" String.of_bool tests in 19 | let debug = on_some_use_opt "--debug" String.of_bool debug in 20 | Cmd.(verb %% dry_run %% raws %% pkg_name %% build_dir %% tests %% debug %% 21 | Cmd.of_list args) 22 | 23 | let build () pkg_file pkg_name build_dir dry_run raws tests debug args = 24 | let pkg = Topkg_care.Pkg.v pkg_file in 25 | let args = build_args pkg_name build_dir dry_run raws tests debug args in 26 | let out = OS.Cmd.out_stdout in 27 | begin 28 | OS.Dir.current () 29 | >>= fun dir -> Topkg_care.Pkg.build pkg ~dir ~args ~out 30 | >>| (function ((), (_, `Exited 0)) -> 0 | _ -> 1) 31 | end 32 | |> Cli.handle_error 33 | 34 | (* Command line interface *) 35 | 36 | open Cmdliner 37 | 38 | let args = 39 | let doc = "Build configuration. Needs to be specified after a -- token 40 | so that the command line options do not get interpreted by 41 | $(b,topkg build) itself." 42 | in 43 | Arg.(value & pos_all string [] & info [] ~doc ~docv:"BUILD_CONF") 44 | 45 | let pkg_name = 46 | let doc = "The name $(docv) of the package (and of the opam install file). 47 | This is equivalent to specify the same option after the -- token. 48 | If absent provided by the package description." 49 | in 50 | let docv = "PKG_NAME" in 51 | Arg.(value & opt (some string) None & info ["n"; "pkg-name"] ~doc ~docv) 52 | 53 | let build_dir = 54 | let doc = "Specifies the build directory $(docv). This is equivalent to 55 | specify the same option after the -- token. If absent, provided 56 | by the package description." 57 | in 58 | let docv = "BUILD_DIR" in 59 | Arg.(value & opt (some Cli.path_arg) None & info ["build-dir"] ~doc ~docv) 60 | 61 | let dry_run = 62 | let doc = "Do not run build instructions, only determine and write the opam 63 | install file. This is equivalent to specify the same option after 64 | the -- token." 65 | in 66 | Arg.(value & flag & info ["d"; "dry-run"] ~doc) 67 | 68 | let raws = 69 | let doc = "Do not run build instructions or write the opam install file, only 70 | invoke the build system with the given $(docv) argument." 71 | in 72 | Arg.(value & opt_all string [] & info ["r"; "raw"] ~doc ~docv:"ARG") 73 | 74 | let tests = 75 | let doc = "Specifies whether tests should be built. If absent depends on the 76 | build context, true for development and false otherwise. This is 77 | equivalent to specify the same option after the -- token." 78 | in 79 | Arg.(value & opt (some bool) None & info ["tests"] ~doc ~docv:"BOOL") 80 | 81 | let debug = 82 | let doc = "Debug build. Specifies if debugging information should be 83 | saved in build artefacts. This is equivalent to specify the 84 | same option after the -- token." 85 | in 86 | let env = Cmd.Env.info "TOPKG_CONF_DEBUG" in 87 | Arg.(value & opt (some bool) None & info ["debug"] ~env ~doc ~docv:"BOOL") 88 | 89 | let doc = "Build the package" 90 | let sdocs = Manpage.s_common_options 91 | let exits = Cmd.Exit.info 1 ~doc:"on build failure." :: Cli.exits 92 | let man_xrefs = [ `Main ] 93 | let man = 94 | [ `S Manpage.s_synopsis; 95 | `P "$(mname) $(tname) [$(i,OPTION)]... [-- $(i,BUILD_CONF)...]"; 96 | `S Manpage.s_description; 97 | `P "The $(tname) command builds the package. This is equivalent to 98 | invoke:"; 99 | `Pre "ocaml ./pkg/pkg.ml build $(i,BUILD_CONF)..."; ] 100 | 101 | let cmd = 102 | Cmd.v (Cmd.info "build" ~doc ~sdocs ~exits ~man ~man_xrefs) @@ 103 | Term.(const build $ Cli.setup $ Cli.pkg_file $ pkg_name $ build_dir $ 104 | dry_run $ raws $ tests $ debug $ args) 105 | -------------------------------------------------------------------------------- /src-bin/browse.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Bos_setup 7 | 8 | (* Targets *) 9 | 10 | let opam_doc_field = 11 | "doc", `Opam "doc", "doc opam file field" 12 | 13 | let opam_homepage_field = 14 | "homepage", `Opam "homepage", "homepage opam file field" 15 | 16 | let opam_issues_field = 17 | "issues", `Opam "bug-reports", "bug-reports opam file field" 18 | 19 | let opam_repo_field = 20 | "repo", `Opam "dev-repo", "dev-repo opam file field" 21 | 22 | let topkg_api = 23 | "topkg-api", `Uri "%%PKG_DOC%%", "topkg's API docs" 24 | 25 | let ocaml_man = 26 | "ocaml-man", `Uri "http://caml.inria.fr/pub/docs/manual-ocaml/", 27 | "OCaml manual" 28 | 29 | let ocaml_issues = 30 | "ocaml-issues", `Uri "http://caml.inria.fr/mantis/", "OCaml issue tracker" 31 | 32 | let ocamlbuild_man = 33 | "ocamlbuild-man", 34 | `Uri "https://github.com/ocaml/ocamlbuild/blob/master/manual/manual.adoc", 35 | "OCamlbuild manual" 36 | 37 | let opam_man = 38 | "opam-man", `Uri "http://opam.ocaml.org/doc/Manual.html", "opam manual" 39 | 40 | let packages = 41 | "packages", `Uri "http://opam.ocaml.org/packages/", "OCaml opam repository" 42 | 43 | let planet = 44 | "planet", `Uri "https://ocaml.org/community/planet/", "OCaml Planet" 45 | 46 | let temptation = 47 | "temptation", 48 | `Uri "https://www.\x2568\x2561\x2573\x256B\x2565\x256C\x256C.org", "" 49 | 50 | let caml_list = 51 | "caml-list", `Uri "http://news.gmane.org/gmane.comp.lang.caml.inria", 52 | "Main OCaml mailing list" 53 | 54 | let weekly_news = 55 | "weekly-news", `Uri "http://alan.petitepomme.net/cwn/", "OCaml Weekly News" 56 | 57 | let targets = 58 | [ opam_doc_field; opam_homepage_field; opam_issues_field; opam_repo_field; 59 | topkg_api; ocaml_man; ocaml_issues; ocamlbuild_man; opam_man; packages; 60 | planet; temptation; caml_list; weekly_news; ] 61 | 62 | let parse_target, max_target_len = 63 | let add (acc, len) (t, v, _) = (t, v) :: acc, max len (String.length t) in 64 | let index, max = List.fold_left add ([], 0) targets in 65 | (* This gives us trie lookup *) 66 | Cmdliner.Arg.conv_parser (Cmdliner.Arg.enum index), max 67 | 68 | (* opam field uris *) 69 | 70 | let opam_field_uri opam field = 71 | Topkg_care.Opam.File.fields opam 72 | >>= fun fields -> match String.Map.find field fields with 73 | | Some (uri :: _) -> Ok uri 74 | | Some [] -> R.error_msgf "%a: field %s is empty" Fpath.pp opam field 75 | | None -> R.error_msgf "%a: field %s is undefined" Fpath.pp opam field 76 | 77 | (* Browse command *) 78 | 79 | let browse () pkg_file opam browser prefix background target = 80 | begin 81 | let uri = match parse_target target with 82 | | Ok (`Uri uri) -> Ok uri 83 | | Ok (`Opam field) -> 84 | let pkg = Topkg_care.Pkg.v ?opam pkg_file in 85 | Topkg_care.Pkg.opam pkg >>= fun opam -> opam_field_uri opam field 86 | | Error msg -> 87 | let uri_prefixes = ["http://"; "https://"; "file://"] in 88 | if List.exists (fun p -> String.is_prefix ~affix:p target) uri_prefixes 89 | then Ok target 90 | else Error msg 91 | in 92 | uri 93 | >>= fun uri -> Webbrowser.reload ~background ~prefix ?browser uri 94 | >>= fun () -> Ok 0 95 | end 96 | |> Cli.handle_error 97 | 98 | (* Command line interface *) 99 | 100 | open Cmdliner 101 | 102 | let target = 103 | let doc = "Target to browse, see above for the list of targets." in 104 | Arg.(value & pos 0 string "homepage" & info [] ~doc ~docv:"TARGET or URI") 105 | 106 | let doc = "Browse the package's WWW links" 107 | let sdocs = Manpage.s_common_options 108 | let exits = Cli.exits 109 | let man_xrefs = [ `Main ] 110 | let man = 111 | let target acc (t, _, doc) = 112 | if doc = "" then acc else 113 | let pad = String.v ~len:(max_target_len - String.length t) (fun _ -> ' ') in 114 | `Pre (strf "%s$(b,%s) %s" pad t doc) :: `Noblank :: acc 115 | in 116 | [ `S Manpage.s_description; 117 | `P "The $(tname) command opens or reloads URIs mentioned in the 118 | opam file in a WWW browser. A few other useful logical target are 119 | provided and arbitrary file, http or https schemed URIs can also 120 | be specified as the target."; 121 | `Blocks (List.(tl @@ rev @@ fold_left target [] targets)); ] 122 | 123 | let cmd = 124 | Cmd.v (Cmd.info "browse" ~doc ~sdocs ~exits ~man ~man_xrefs) @@ 125 | Term.(const browse $ Cli.setup $ Cli.pkg_file $ Cli.opam $ 126 | Webbrowser_cli.browser $ Webbrowser_cli.prefix $ 127 | Webbrowser_cli.background $ target) 128 | -------------------------------------------------------------------------------- /src-bin/publish.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Bos_setup 7 | 8 | let absolute path = OS.Dir.current () >>| fun cwd -> Fpath.(cwd // path) 9 | 10 | let gen_doc dir = 11 | let do_doc () = 12 | OS.Cmd.run Cmd.(v "topkg" % "doc") 13 | >>| fun () -> Fpath.(dir / "_build" / "doc" / "api.docdir") 14 | in 15 | R.join @@ OS.Dir.with_current dir do_doc () 16 | 17 | let publish_doc pkg = 18 | Topkg_care.Pkg.distrib_file pkg 19 | >>= fun distrib_file -> Topkg_care.Pkg.publish_msg pkg 20 | >>= fun msg -> Topkg_care.Archive.untbz ~clean:true distrib_file 21 | >>= fun dir -> gen_doc dir 22 | >>= fun docdir -> absolute docdir 23 | >>= fun docdir -> Topkg_care.Delegate.publish_doc pkg ~msg ~docdir 24 | 25 | let publish_distrib pkg = 26 | Topkg_care.Pkg.distrib_file pkg 27 | >>= fun distrib_file -> Topkg_care.Pkg.publish_msg pkg 28 | >>= fun msg -> absolute distrib_file 29 | >>= fun archive -> Topkg_care.Delegate.publish_distrib pkg ~msg ~archive 30 | 31 | let publish_alt pkg kind = 32 | Topkg_care.Pkg.distrib_file pkg 33 | >>= fun distrib_file -> Topkg_care.Pkg.publish_msg pkg 34 | >>= fun msg -> absolute distrib_file 35 | >>= fun archive -> Topkg_care.Delegate.publish_alt pkg ~kind ~msg ~archive 36 | 37 | let publish () 38 | pkg_file build_dir name version opam delegate change_log distrib_uri 39 | distrib_file publish_msg publish_artefacts 40 | = 41 | begin 42 | let publish_artefacts = match publish_artefacts with 43 | | [] -> None 44 | | v -> Some v 45 | in 46 | let pkg = Topkg_care.Pkg.v ?name ?version ?build_dir ?opam ?delegate 47 | ?change_log ?distrib_uri ?distrib_file ?publish_msg 48 | ?publish_artefacts pkg_file 49 | in 50 | let publish_artefact acc artefact = 51 | acc >>= fun acc -> match artefact with 52 | | `Doc -> publish_doc pkg 53 | | `Distrib -> publish_distrib pkg 54 | | `Alt kind -> publish_alt pkg kind 55 | in 56 | Topkg_care.Pkg.publish_artefacts pkg 57 | >>= fun todo -> List.fold_left publish_artefact (Ok ()) todo 58 | >>= fun () -> Ok 0 59 | end 60 | |> Cli.handle_error 61 | 62 | (* Command line interface *) 63 | 64 | open Cmdliner 65 | 66 | let artefacts = 67 | let alt_prefix = "alt-" in 68 | let parser = function 69 | | "do" | "doc" -> Ok `Doc 70 | | "di" | "dis" | "dist" | "distr" | "distri" | "distrib" -> Ok `Distrib 71 | | s when String.is_prefix ~affix:alt_prefix s -> 72 | begin match String.(with_range ~first:(length alt_prefix) s) with 73 | | "" -> Error ("`alt-' alternative artefact kind is missing") 74 | | kind -> Ok (`Alt kind) 75 | end 76 | | s -> Error (strf "`%s' unknown publication artefact" s) 77 | in 78 | let printer ppf = function 79 | | `Doc -> Fmt.string ppf "doc" 80 | | `Distrib -> Fmt.string ppf "distrib" 81 | | `Alt a -> Fmt.pf ppf "alt-%s" a 82 | in 83 | let artefact = Arg.conv' (parser, printer) in 84 | let doc = strf "The artefact to publish. $(docv) must be one of `doc`, 85 | `distrib` or `alt-$(i,KIND)`. If absent, the set of 86 | default publication artefacts is determined by the 87 | package description." 88 | in 89 | Arg.(value & pos_all artefact [] & info [] ~doc ~docv:"ARTEFACT") 90 | 91 | let doc = "Publish package distribution archives and derived artefacts" 92 | let sdocs = Manpage.s_common_options 93 | let exits = Cli.exits 94 | let envs = 95 | [ Cmd.Env.info "TOPKG_DELEGATE" ~doc:"The package delegate to use, see 96 | topkg-delegate(7)."; ] 97 | 98 | let man_xrefs = [`Main; `Cmd "distrib" ] 99 | let man = 100 | [ `S Manpage.s_synopsis; 101 | `P "$(mname) $(tname) [$(i,OPTION)]... [$(i,ARTEFACT)]..."; 102 | `S Manpage.s_description; 103 | `P "The $(tname) command publishes package distribution archives 104 | and other artefacts via the package delegate. See topkg-delegate(7) for 105 | more details."; 106 | `P "Artefact publication always relies on a distribution archive having 107 | been generated before with topkg-distrib(1)."; 108 | `S "ARTEFACTS"; 109 | `I ("$(b,distrib)", 110 | "Publishes a distribution archive on the WWW."); 111 | `I ("$(b,doc)", 112 | "Publishes the documentation of a distribution archive on the WWW."); 113 | `I ("$(b,alt)-$(i,KIND)", 114 | "Publishes the alternative artefact of kind $(i,KIND) of 115 | a distribution archive. The semantics of alternative artefacts 116 | is left to the delegate, it could be anything, an email, 117 | a pointless tweet, a feed entry etc. See topkg-delegate(7) for 118 | more details."); ] 119 | 120 | let cmd = 121 | Cmd.v (Cmd.info "publish" ~doc ~sdocs ~exits ~envs ~man ~man_xrefs) @@ 122 | Term.(const publish $ Cli.setup $ Cli.pkg_file $ Cli.build_dir $ 123 | Cli.dist_name $ Cli.dist_version $ Cli.dist_opam $ 124 | Cli.delegate $ Cli.change_log $ Cli.dist_uri $ Cli.dist_file $ 125 | Cli.publish_msg $ artefacts) 126 | -------------------------------------------------------------------------------- /src/topkg_string.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | let strf = Format.asprintf 7 | 8 | include String 9 | 10 | let head s = if s = "" then None else Some s.[0] 11 | 12 | (* Predicates *) 13 | 14 | let is_prefix ~affix s = 15 | let len_a = length affix in 16 | let len_s = length s in 17 | if len_a > len_s then false else 18 | let max_idx_a = len_a - 1 in 19 | let rec loop i = 20 | if i > max_idx_a then true else 21 | if unsafe_get affix i <> unsafe_get s i then false else loop (i + 1) 22 | in 23 | loop 0 24 | 25 | let is_suffix ~affix s = 26 | let max_idx_a = length affix - 1 in 27 | let max_idx_s = length s - 1 in 28 | if max_idx_a > max_idx_s then false else 29 | let rec loop i = 30 | if i > max_idx_a then true else 31 | if unsafe_get affix (max_idx_a - i) <> unsafe_get s (max_idx_s - i) 32 | then false 33 | else loop (i + 1) 34 | in 35 | loop 0 36 | 37 | let for_all sat s = 38 | let max_idx = length s - 1 in 39 | let rec loop i = 40 | if i > max_idx then true else 41 | if sat (unsafe_get s i) then loop (i + 1) else false 42 | in 43 | loop 0 44 | 45 | let exists sat s = 46 | let max_idx = length s - 1 in 47 | let rec loop i = 48 | if i > max_idx then false else 49 | if sat (unsafe_get s i) then true else loop (i + 1) 50 | in 51 | loop 0 52 | 53 | (* Traversing *) 54 | 55 | let find_byte ?(start = 0) c s = 56 | let max = String.length s - 1 in 57 | if start > max then None else 58 | try Some (String.index_from s start c) with Not_found -> None 59 | 60 | (* Extracting substrings *) 61 | 62 | let with_index_range ?(first = 0) ?last s = 63 | let max = String.length s - 1 in 64 | let last = match last with 65 | | None -> max 66 | | Some l when l > max -> max 67 | | Some l -> l 68 | in 69 | let first = if first < 0 then 0 else first in 70 | if first > last then "" else 71 | String.sub s first (last - first + 1) 72 | 73 | let cut ?(rev = false) ~sep s = 74 | let find_index = if rev then String.rindex else String.index in 75 | match try Some (find_index s sep) with Not_found -> None with 76 | | None -> None 77 | | Some i -> 78 | Some (String.sub s 0 i, String.sub s (i+1) (String.length s - i - 1)) 79 | 80 | let cuts ?(empty = true) ~sep s = 81 | let no_empty = not empty in 82 | let rec loop acc s = match cut ~sep s with 83 | | Some (v, vs) -> loop (if no_empty && v = "" then acc else (v :: acc)) vs 84 | | None -> List.rev (if no_empty && s = "" then acc else (s :: acc)) 85 | in 86 | loop [] s 87 | 88 | (* Version strings *) 89 | 90 | let parse_version v = 91 | let version = 92 | if is_prefix ~affix:"v" v then with_index_range ~first:1 v else v 93 | in 94 | let cut_left_plus_or_tilde s = 95 | let cut = match String.index_opt s '+', String.index_opt s '~' with 96 | | None, None -> None 97 | | (Some _ as i), None | None, (Some _ as i) -> i 98 | | Some i, Some i' -> Some (if i < i' then i else i') 99 | in 100 | match cut with 101 | | None -> None 102 | | Some i -> 103 | Some (with_index_range ~last:(i - 1) s, with_index_range ~first:i s) 104 | in 105 | try match cut ~sep:'.' version with 106 | | None -> None 107 | | Some (maj, rest) -> 108 | let maj = int_of_string maj in 109 | match cut ~sep:'.' rest with 110 | | None -> 111 | begin match cut_left_plus_or_tilde rest with 112 | | None -> Some (maj, int_of_string rest, 0, None) 113 | | Some (min, i) -> Some (maj, int_of_string min, 0, Some i) 114 | end 115 | | Some (min, rest) -> 116 | let min = int_of_string min in 117 | begin match cut_left_plus_or_tilde rest with 118 | | None -> Some (maj, min, int_of_string rest, None) 119 | | Some (p, i) -> Some (maj, min, int_of_string p, Some i) 120 | end 121 | with 122 | | Failure _ -> None 123 | 124 | let drop_initial_v version = match head version with 125 | | Some ('v' | 'V') -> with_index_range ~first:1 version 126 | | None | Some _ -> version 127 | 128 | (* Formatters *) 129 | 130 | let pp_text ppf s = (* was c&p from Fmt, pp_print_text is 4.02 *) 131 | let is_nl_or_sp c = c = '\n' || c = ' ' in 132 | let rec stop_at sat ~start ~max s = 133 | if start > max then start else 134 | if sat s.[start] then start else 135 | stop_at sat ~start:(start + 1) ~max s 136 | in 137 | let sub s start stop ~max = 138 | if start = stop then "" else 139 | if start = 0 && stop > max then s else 140 | String.sub s start (stop - start) 141 | in 142 | let max = String.length s - 1 in 143 | let rec loop start s = match stop_at is_nl_or_sp ~start ~max s with 144 | | stop when stop > max -> Format.pp_print_string ppf (sub s start stop ~max) 145 | | stop -> 146 | Format.pp_print_string ppf (sub s start stop ~max); 147 | begin match s.[stop] with 148 | | ' ' -> Format.pp_print_space ppf () 149 | | '\n' -> Format.pp_force_newline ppf () 150 | | _ -> assert false 151 | end; 152 | loop (stop + 1) s 153 | in 154 | loop 0 s 155 | -------------------------------------------------------------------------------- /src-bin/issue.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Bos_setup 7 | 8 | let get_id = function 9 | | Some id -> Ok id 10 | | None -> R.error_msgf "No issue ID specified" 11 | 12 | let get_issue_msg ~info = function 13 | | Some "" -> Ok None 14 | | Some msg -> Ok (Some (String.cuts ~sep:"\n" msg)) 15 | | None -> 16 | let is_msg s = not (String.is_prefix ~affix:"#" s) in 17 | let rec rem_white_prefix = function 18 | | l :: ls when String.for_all Char.Ascii.is_white l -> rem_white_prefix ls 19 | | ls -> ls 20 | in 21 | OS.File.tmp "topkg-issue-msg-%s" 22 | >>= fun f -> OS.File.write f info 23 | >>= fun () -> Topkg_care.Text.edit_file f 24 | >>= function 25 | | 0 -> 26 | OS.File.read f >>= fun m -> 27 | let msg = List.filter is_msg (String.cuts ~sep:"\n" m) in 28 | begin match rem_white_prefix msg with 29 | | [] -> Ok None 30 | | lines -> Ok (Some lines) 31 | end 32 | | n -> 33 | Logs.err (fun m -> m "Editor exited with non-zero error code."); 34 | Ok None 35 | 36 | (* Actions *) 37 | 38 | let issue_show pkg ~id = 39 | get_id id >>= fun id -> Topkg_care.Delegate.issue_show pkg ~id 40 | 41 | let issue_open pkg msg = 42 | let open_info = 43 | "\n\ 44 | # Please enter an issue description. The first non-blank line will be\n\ 45 | # the issue title and the rest the issue description. Lines starting\n\ 46 | # with '#' will be ignored. An empty description aborts the action." 47 | in 48 | get_issue_msg ~info:open_info msg >>= function 49 | | None -> 50 | Logs.app (fun m -> m "Open issue aborted due to empty issue message."); 51 | Ok (); 52 | | Some lines -> 53 | let title, body = match lines with 54 | | title :: body -> title, String.(trim @@ concat ~sep:"\n" body) 55 | | [] -> assert false 56 | in 57 | Topkg_care.Delegate.issue_open pkg ~title ~body 58 | 59 | let issue_close pkg ~id msg = 60 | let close_info = 61 | "\n\ 62 | # Please enter a closing message. Lines starting with '#' will\n\ 63 | # be ignored. An empty message aborts the action." 64 | in 65 | get_id id 66 | >>= fun id -> get_issue_msg ~info:close_info msg 67 | >>= function 68 | | None -> 69 | Logs.app 70 | (fun m -> m "Close issue %s aborted due to empty issue message." id); 71 | Ok () 72 | | Some lines -> 73 | let msg = String.(trim @@ concat ~sep:"\n" lines) in 74 | Topkg_care.Delegate.issue_close pkg ~id ~msg 75 | 76 | (* Command *) 77 | 78 | let issue () pkg_file opam delegate action id msg = 79 | begin 80 | let pkg = Topkg_care.Pkg.v ?opam ?delegate pkg_file in 81 | let ret = match action with 82 | | `List -> Topkg_care.Delegate.issue_list pkg 83 | | `Show -> issue_show pkg ~id 84 | | `Open -> issue_open pkg msg 85 | | `Close -> issue_close pkg ~id msg 86 | in 87 | ret >>= fun () -> Ok 0 88 | end 89 | |> Cli.handle_error 90 | 91 | (* Command line interface *) 92 | 93 | open Cmdliner 94 | 95 | let action = 96 | let action = ["list",`List; "show",`Show; "open",`Open; "close",`Close;] in 97 | let doc = strf "The action to perform. $(docv) must be one of %s." 98 | (Arg.doc_alts_enum action) 99 | in 100 | let cmd = Arg.enum action in 101 | Arg.(value & pos 0 cmd `List & info [] ~doc ~docv:"ACTION") 102 | 103 | let id = 104 | let doc = "An issue ID of the package's issue tracker." in 105 | Arg.(value & pos 1 (some string) None & info [] ~doc ~docv:"ID") 106 | 107 | let msg = 108 | let doc = "For $(b,open) and $(b,close), $(docv) is the issue message. 109 | Prevents the interactive prompt for the message." 110 | in 111 | let docv = "MSG" in 112 | Arg.(value & opt (some string) None & info ["m"; "message"] ~doc ~docv) 113 | 114 | let doc = "Interact with the package's issue tracker" 115 | let sdocs = Manpage.s_common_options 116 | let exits = Cli.exits 117 | let envs = 118 | [ Cmd.Env.info "EDITOR" ~doc:"The editor used to edit issue messages."; 119 | Cmd.Env.info "TOPKG_DELEGATE" ~doc:"The package delegate to use, see 120 | topkg-delegate(7)." ] 121 | 122 | let man_xrefs = [ `Main ] 123 | let man = 124 | [ `S Manpage.s_synopsis; 125 | `P "$(mname) $(tname) [$(i,OPTION)]... [$(i,ACTION)]..."; 126 | `S Manpage.s_description; 127 | `P "The $(tname) command interacts with the package's issue 128 | tracker via the package delegate. See topkg-delegate(7) for more 129 | details."; 130 | `P "To consult the issues in a WWW browser invoke 131 | $(b,topkg browse issues), no delegate is needed for this."; 132 | `S "ACTIONS"; 133 | `I ("$(b,list) (default)", 134 | "List open issues."); 135 | `I ("$(b,show) $(i,ID)", 136 | "Show information about issue $(i,ID)."); 137 | `I ("$(b,open)", 138 | "Open a new issue."); 139 | `I ("$(b,close) $(i,ID)", 140 | "Close issue $(i,ID).") ] 141 | 142 | let cmd = 143 | Cmd.v (Cmd.info "issue" ~doc ~sdocs ~exits ~envs ~man ~man_xrefs) @@ 144 | Term.(const issue $ Cli.setup $ Cli.pkg_file $ Cli.opam $ Cli.delegate $ 145 | action $ id $ msg) 146 | -------------------------------------------------------------------------------- /src-bin/log.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Bos_setup 7 | 8 | (* Actions *) 9 | 10 | let show change_log last last_version no_pager = 11 | let text = 12 | if not (last || last_version) then OS.File.read change_log else 13 | (Topkg_care.Text.change_log_file_last_entry change_log 14 | >>= fun (v, (h, t)) -> Ok (if last_version then v else strf "%s\n%s" h t)) 15 | in 16 | text 17 | >>= fun text -> Topkg_care.Text.find_pager ~don't:(no_pager || last_version) 18 | >>= function 19 | | None -> Logs.app (fun m -> m "%s" text); Ok () 20 | | Some pager -> OS.Cmd.(in_string text |> run_in pager) 21 | 22 | let commit change_log = 23 | let change_log = Fpath.to_string change_log in 24 | Topkg.Vcs.get () 25 | >>= fun repo -> Topkg.Vcs.file_is_dirty repo change_log 26 | >>= function 27 | | true -> Topkg.Vcs.commit_files repo ~msg:"Update change log." [change_log] 28 | | false -> 29 | Logs.app (fun m -> m "No changes to commit in %s" change_log); Ok () 30 | 31 | (* Command *) 32 | 33 | let log () pkg_file change_log action last last_version no_pager = 34 | begin 35 | let pkg = Topkg_care.Pkg.v ?change_log pkg_file in 36 | Topkg_care.Pkg.change_log pkg 37 | >>= fun change_log -> match action with 38 | | `Show -> show change_log last last_version no_pager >>= fun () -> Ok 0 39 | | `Edit -> Topkg_care.Text.edit_file change_log 40 | | `Commit -> commit change_log >>= fun () -> Ok 0 41 | end 42 | |> Cli.handle_error 43 | 44 | (* Command line interface *) 45 | 46 | open Cmdliner 47 | 48 | let action = 49 | let action = [ "show", `Show; "edit", `Edit; "commit", `Commit] in 50 | let doc = strf "The action to perform. $(docv) must be one of %s." 51 | (Arg.doc_alts_enum action) 52 | in 53 | let cmd = Arg.enum action in 54 | Arg.(value & pos 0 cmd `Show & info [] ~doc ~docv:"ACTION") 55 | 56 | let no_pager = 57 | let doc = "Do not pipe the output into a pager. This automatically 58 | happens if the TERM environment variable is 'dumb' or undefined." 59 | in 60 | Arg.(value & flag & info ["no-pager"] ~doc) 61 | 62 | let last = 63 | let doc = "Show only the change log of the last version. Extracted as the 64 | first marked up section of the change log." 65 | in 66 | Arg.(value & flag & info ["l"; "last"] ~doc) 67 | 68 | let last_version = 69 | let doc = "Show only the version string of the last version. Extracted as 70 | the first token of the title of the first marked up section of 71 | the change log. Implies $(b,--no-pager)."; 72 | in 73 | Arg.(value & flag & info ["t"; "last-version"] ~doc) 74 | 75 | let doc = "Show and edit the package's change log" 76 | let sdocs = Manpage.s_common_options 77 | let exits = Cli.exits 78 | let envs = 79 | [ Cmd.Env.info "EDITOR" ~doc:"The editor used to edit the change log."; 80 | Cmd.Env.info "PAGER" ~doc:"The pager used to consult the change log."; 81 | Cmd.Env.info "TERM" ~doc:"See option $(b,--no-pager)." ] 82 | 83 | let man_xrefs = [ `Main; `Cmd "publish"; `Cmd "tag"; `Cmd "opam"; ] 84 | let man = 85 | [ `S Manpage.s_description; 86 | `P "The $(tname) command shows, edits and commits 87 | the package's change log."; 88 | `S "CHANGE LOG FORMAT"; 89 | `P "To be able to extract the version and changes of the last distribution, 90 | a well defined change log format is assumed. Not abiding to the 91 | format is not catastrophic but may hinder or derail some facilities 92 | provided by topkg."; 93 | `P "The format assumes that the change log is written either in Markdown 94 | (default or .md extension) or Asciidoc (.asciidoc or .adoc extension). 95 | A change log is a list of marked up sections. A section is 96 | a header of any level until the next header at the same level or 97 | the end of file. For example here are two Markdown sections:"; 98 | `Pre "\ 99 | v2.0.0 100 | ------ 101 | ### New features 102 | etc. 103 | ### Breaking changes 104 | etc. 105 | 106 | v1.6.0 1995-09-12 107 | ----------------- 108 | etc."; 109 | `P "The first marked up section in the file is taken as being the 110 | change log for the last distribution; use $(b,topkg log -l) 111 | to check that it is parsed correctly. This is used by topkg-publish(1) 112 | and topkg-opam(1) to enrich distribution publication."; 113 | `P "The first token of the first section header title is taken as being the 114 | version string of the distribution; use $(b,topkg log -t) to check 115 | that it is parsed correctly. It is used by topkg-tag(1) to tag the 116 | source repository."; 117 | `S "ACTIONS"; 118 | `I ("$(b,show) (default)", "shows the package's change log."); 119 | `I ("$(b,edit)", "edit the package's change log."); 120 | `I ("$(b,commit)", "commit changes made to the package's change log to the 121 | VCS.") ] 122 | 123 | let cmd = 124 | Cmd.v (Cmd.info "log" ~doc ~sdocs ~exits ~envs ~man) @@ 125 | Term.(const log $ Cli.setup $ Cli.pkg_file $ Cli.change_log $ action $ 126 | last $ last_version $ no_pager) 127 | -------------------------------------------------------------------------------- /src/topkg_distrib.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Topkg_result 7 | 8 | (* Watermarks *) 9 | 10 | type watermark = 11 | string * 12 | [ `String of string 13 | | `Name 14 | | `Version 15 | | `Version_num 16 | | `Vcs of [ `Commit_id ] 17 | | `Opam of Topkg_fpath.t option * string * string ] 18 | 19 | let opam_fields file = 20 | (Topkg_opam.File.fields file) 21 | |> R.reword_error_msg ~replace:true (fun msg -> R.msgf "Watermarks: %s" msg) 22 | |> Topkg_log.on_error_msg ~level:Topkg_log.Warning ~use:(fun () -> []) 23 | 24 | let opam_field = 25 | let find k m = try Some (List.assoc k m) with Not_found -> None in 26 | let opam_memo = ref [] in (* memoizes the opam files *) 27 | let rec opam_field file field = match find file !opam_memo with 28 | | None -> 29 | opam_memo := (file, (opam_fields file)) :: !opam_memo; 30 | opam_field file field 31 | | Some fields -> 32 | match find field fields with 33 | | Some vs -> vs 34 | | None -> 35 | Topkg_log.warn 36 | (fun m -> m "file %s: opam field %S undefined or unsupported" 37 | file field); 38 | ["UNDEFINED"] 39 | in 40 | opam_field 41 | 42 | let vcs_commit_id () = 43 | (Topkg_vcs.get () >>= fun repo -> Topkg_vcs.head ~dirty:true repo) 44 | |> R.reword_error_msg ~replace:true 45 | (fun msg -> R.msgf "Watermarks: VCS commit id determination: %s" msg) 46 | |> Topkg_log.on_error_msg ~level:Topkg_log.Warning 47 | ~use:(fun () -> "UNDEFINED") 48 | 49 | let define_watermarks ~name ~version ~opam watermarks = 50 | let define (id, v) = 51 | let (id, v as def) = match v with 52 | | `String s -> (id, s) 53 | | `Version -> (id, version) 54 | | `Version_num -> (id, Topkg_string.drop_initial_v version) 55 | | `Name -> (id, name) 56 | | `Vcs `Commit_id -> (id, vcs_commit_id ()) 57 | | `Opam (file, field, sep) -> 58 | let file = match file with None -> opam | Some file -> file in 59 | (id, String.concat sep (opam_field file field)) 60 | in 61 | Topkg_log.info (fun m -> m "Watermark %s = %S" id v); 62 | def 63 | in 64 | List.map define watermarks 65 | 66 | let watermark_file ws file = 67 | Topkg_os.File.read file >>= fun content -> 68 | Topkg_os.File.write_subst file ws content >>= fun () -> 69 | Topkg_log.info (fun m -> m "Watermarked %s" file); Ok () 70 | 71 | let rec watermark_files ws = function 72 | | [] -> Ok () 73 | | f :: fs -> watermark_file ws f >>= fun () -> watermark_files ws fs 74 | 75 | (* Defaults *) 76 | 77 | let default_watermarks = 78 | let space = " " in 79 | let comma = ", " in 80 | [ "NAME", `Name; 81 | "VERSION", `Version; 82 | "VERSION_NUM", `Version_num; 83 | "VCS_COMMIT_ID", `Vcs `Commit_id; 84 | "PKG_MAINTAINER", `Opam (None, "maintainer", comma); 85 | "PKG_AUTHORS", `Opam (None, "authors", comma); 86 | "PKG_HOMEPAGE", `Opam (None, "homepage", comma); 87 | "PKG_ISSUES", `Opam (None, "bug-reports", space); 88 | "PKG_DOC", `Opam (None, "doc", space); 89 | "PKG_LICENSE", `Opam (None, "license", comma); 90 | "PKG_REPO", `Opam (None, "dev-repo", space); ] 91 | 92 | let default_files_to_watermark = 93 | let is_file f = 94 | Topkg_os.File.exists f |> Topkg_log.on_error_msg ~use:(fun _ -> false) 95 | in 96 | let is_binary_ext ext = 97 | let module Set = Set.Make (String) in 98 | let exts = 99 | Set.(empty |> 100 | add ".eps" |> add ".flv" |> add ".gif" |> add ".ico" |> 101 | add ".jpeg" |> add ".jpg" |> add ".mov" |> add ".mp3" |> 102 | add ".mp4" |> add ".otf" |> add ".pdf" |> add ".png" |> 103 | add ".ps" |> add ".ttf" |> add ".woff") 104 | in 105 | Set.mem ext exts 106 | in 107 | let keep f = not (is_binary_ext @@ Topkg_fpath.get_ext f) && is_file f in 108 | fun () -> 109 | Topkg_vcs.get () 110 | >>= fun repo -> Topkg_vcs.tracked_files repo 111 | >>= fun files -> Ok (List.filter keep files) 112 | 113 | let default_massage () = Ok () 114 | 115 | let default_exclude_paths () = 116 | Ok [".git"; ".gitignore"; ".gitattributes"; ".hg"; ".hgignore"; "build"; 117 | "Makefile"; "_build"] 118 | 119 | (* Distribution *) 120 | 121 | type t = 122 | { watermarks : watermark list; 123 | files_to_watermark : unit -> Topkg_fpath.t list result; 124 | massage : unit -> unit result; 125 | exclude_paths : unit -> Topkg_fpath.t list result; 126 | uri : string option; } 127 | 128 | let v 129 | ?(watermarks = default_watermarks) 130 | ?(files_to_watermark = default_files_to_watermark) 131 | ?(massage = fun () -> Ok ()) 132 | ?(exclude_paths = default_exclude_paths) 133 | ?uri () = 134 | { watermarks; files_to_watermark; massage; exclude_paths; uri } 135 | 136 | let watermarks d = d.watermarks 137 | let files_to_watermark d = d.files_to_watermark 138 | let massage d = d.massage 139 | let exclude_paths d = d.exclude_paths 140 | let uri d = d.uri 141 | let codec = 142 | let uri = Topkg_codec.(with_kind "uri" @@ option string) in 143 | let fields = 144 | let stub () = invalid_arg "not executable outside package definition" in 145 | (fun d -> d.uri), 146 | (fun uri -> 147 | { watermarks = [] (* bad *); files_to_watermark = stub; 148 | massage = stub; exclude_paths = stub; uri }) 149 | in 150 | Topkg_codec.version 0 @@ 151 | Topkg_codec.(view ~kind:"distrib" fields uri) 152 | -------------------------------------------------------------------------------- /src-bin/doc.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Bos_setup 7 | 8 | let unixy_path p = 9 | (* ocamlbuild doesn't like Windows paths it seems. Try to do our best here. *) 10 | let volume, p = Fpath.split_volume p in 11 | volume ^ (String.concat ~sep:"/" (Fpath.segs p)) 12 | 13 | let copy_assets src_dir dst_dir = 14 | let copy_asset dst_dir file = match Fpath.get_ext file with 15 | | ".css" | ".svg" | ".svgz" | ".png" | ".jpeg" | ".gif" | ".woff" | ".ttf" 16 | | ".otf" | ".eot" -> 17 | begin OS.File.exists file >>= function 18 | | false -> Ok () 19 | | true -> 20 | OS.File.read file 21 | >>= fun cont -> OS.File.write Fpath.(dst_dir / filename file) cont 22 | end 23 | |> Logs.on_error_msg ~use:(fun () -> ()) 24 | | _ -> () 25 | in 26 | OS.Dir.exists src_dir >>= function 27 | | false -> Ok () 28 | | true -> 29 | OS.Dir.contents src_dir 30 | >>= fun files -> List.iter (copy_asset dst_dir) files; Ok () 31 | 32 | let copy_odig_css doc_dir dst_dir = 33 | OS.File.exists Fpath.(doc_dir / "style.css") >>= function 34 | | true -> Ok () 35 | | false -> 36 | let get_odig_etc = Cmd.(v "opam" % "var" % "odig:etc") in 37 | OS.Cmd.(run_out get_odig_etc |> to_string) >>= function 38 | | "#undefined" (* no comment *) -> Ok () 39 | | etcdir -> 40 | Fpath.of_string etcdir >>= fun etcdir -> 41 | OS.File.read Fpath.(etcdir / "ocamldoc.css") 42 | >>= fun cont -> OS.File.write Fpath.(dst_dir / "style.css") cont 43 | 44 | let doc_build_args pkg_name build_dir dev target = 45 | let verb = Cli.propagate_verbosity_to_pkg_file () in 46 | let pkg_name = Cmd.(v "--pkg-name" % pkg_name) in 47 | let build_dir = Cmd.(v "--build-dir" % Cmd.p build_dir) in 48 | let target = unixy_path target in 49 | let doc_flags = ["-docflags"; "-colorize-code,-charset,utf-8"; target ] in 50 | let raws = Cmd.of_list ~slip:"--raw" doc_flags in 51 | Cmd.(verb %% pkg_name %% build_dir %% raws) 52 | 53 | let build_doc pkg pkg_name build_dir dev = 54 | let out = OS.Cmd.to_stdout in 55 | let doc_dir = Fpath.v "doc" in 56 | let odocl = Fpath.(doc_dir / (if dev then "dev.odocl" else "api.odocl")) in 57 | Ok Fpath.(set_ext ".docdir" odocl / "index.html") 58 | >>= fun target -> Ok (doc_build_args pkg_name build_dir dev target) 59 | >>= fun args -> OS.Dir.current () 60 | >>= fun dir -> Topkg_care.Pkg.build pkg ~dir ~args ~out 61 | >>= fun () -> Ok Fpath.(build_dir // parent target) 62 | >>= fun dst_dir -> copy_assets doc_dir dst_dir 63 | >>= fun () -> copy_odig_css doc_dir dst_dir 64 | >>= fun () -> Ok dst_dir 65 | 66 | let browser_reload reload ~background ~browser dir = 67 | OS.Dir.current () 68 | >>= fun cwd -> Ok Fpath.(cwd // dir) 69 | >>= fun abs_dir -> match not (reload || background) with 70 | | true -> Ok abs_dir 71 | | false -> 72 | let uri = strf "file://%s" Fpath.(to_string abs_dir) in 73 | Webbrowser.reload ~background ~prefix:true ?browser uri 74 | >>= fun () -> Ok abs_dir 75 | 76 | let doc_cmd () pkg_file name build_dir dev reload background browser = 77 | begin 78 | let pkg = Topkg_care.Pkg.v ?build_dir ?name pkg_file in 79 | Topkg_care.Pkg.name pkg 80 | >>= fun pkg_name -> Topkg_care.Pkg.build_dir pkg 81 | >>= fun build_dir -> build_doc pkg pkg_name build_dir dev 82 | >>= fun docdir -> browser_reload reload ~background ~browser docdir 83 | >>= fun abs_docdir -> 84 | Logs.app (fun m -> 85 | m "Generated %s doc in %a" 86 | (if dev then "dev" else "API") Topkg_care.Pp.path abs_docdir); 87 | Ok 0 88 | end 89 | |> Cli.handle_error 90 | 91 | (* Command line interface *) 92 | 93 | open Cmdliner 94 | 95 | let reload_browser = 96 | let doc = "Open an URI of the documentation directory or reload an 97 | existing browser tab that holds a sub-page of the documentation." 98 | in 99 | Arg.(value & flag & info ["r"; "reload-browser"] ~doc) 100 | 101 | let dev = 102 | let doc = "Build the development documentation." in 103 | Arg.(value & flag & info ["d"; "dev"] ~doc) 104 | 105 | let doc = "Build the package's API documentation" 106 | let sdocs = Manpage.s_common_options 107 | let exits = Cli.exits 108 | let man_xrefs = [ `Main ] 109 | let man = 110 | [ `S Manpage.s_description; 111 | `P "The $(tname) command builds the package's API documentation. Use 112 | the option $(b,-r) to open or refresh the documentation in 113 | a WWW browser (see $(b,--browser) for details)."; 114 | `P "$(b,WARNING.) The way this command works is at the 115 | moment very ad-hoc and ocamlbuild specific. It will 116 | change in the future."; 117 | `P "Current support relies on having a doc/ directory at the root of the 118 | distribution. The ocamlbuild file doc/api.odocl defines the API 119 | documentation and the doc/dev.odocl the development documentation. 120 | The directory can also hold CSS, PNG, JPEG, GIF, SVG, WOFF, TTF, OTF 121 | files that are copied over to the generated documentation directory."; 122 | `P "The package's build system is invoked via `--raw` with the 123 | ocamlbuild documentation targets."; 124 | `P "If the doc/ directory has no doc/style.css file but odig(1) is 125 | installed, its ocamldoc stylesheet is used." ] 126 | 127 | let cmd = 128 | Cmd.v (Cmd.info "doc" ~doc ~sdocs ~exits ~man ~man_xrefs) @@ 129 | Term.(const doc_cmd $ Cli.setup $ Cli.pkg_file $ Cli.pkg_name $ Cli.build_dir 130 | $ dev $ reload_browser $ Webbrowser_cli.background $ 131 | Webbrowser_cli.browser) 132 | -------------------------------------------------------------------------------- /src-care/topkg_care_archive.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Bos_setup 7 | 8 | (* Ustar archives *) 9 | 10 | module Tar = struct 11 | 12 | type ptime = int 13 | type t = string list 14 | 15 | let empty = [] 16 | 17 | (* Header. 18 | 19 | See http://pubs.opengroup.org/onlinepubs/9699919799/utilities/\ 20 | pax.html#tag_20_92_13_06 *) 21 | 22 | let to_unix_path_string = 23 | if Fpath.dir_sep = "/" then Fpath.to_string else 24 | fun f -> String.concat ~sep:"/" (Fpath.segs f) 25 | 26 | let set_filename h f = 27 | let s = to_unix_path_string f in 28 | match String.length s with 29 | | n when n <= 100 -> Bytes.blit_string s 0 h 0 (String.length s) 30 | | n -> 31 | try match String.cut ~rev:true ~sep:"/" s with 32 | | None -> raise Exit 33 | | Some (p, n) -> 34 | (* This could be made more clever by trying to find 35 | the slash nearest to the half string position. *) 36 | if String.length p > 155 || String.length n > 100 then raise Exit; 37 | Bytes.blit_string n 0 h 0 (String.length n); 38 | Bytes.blit_string p 0 h 345 (String.length p); 39 | with 40 | | Exit -> failwith (strf "%a: file name too long" Fpath.pp f) 41 | 42 | let set_string off h s = Bytes.blit_string s 0 h off (String.length s) 43 | let set_octal field off len (* terminating NULL included *) h n = 44 | let octal = Printf.sprintf "%0*o" (len - 1) n in 45 | if String.length octal < len 46 | then Bytes.blit_string octal 0 h off (String.length octal) else 47 | failwith (strf "field %s: can't encode %d in %d-digit octal number" 48 | field (len - 1) n) 49 | 50 | let header_checksum h = 51 | let len = Bytes.length h in 52 | let rec loop acc i = 53 | if i > len then acc else 54 | loop (acc + (Char.to_int @@ Bytes.unsafe_get h i)) (i + 1) 55 | in 56 | loop 0 0 57 | 58 | let header fname mode mtime size typeflag = 59 | try 60 | let h = Bytes.make 512 '\x00' in 61 | set_filename h fname; 62 | set_octal "mode" 100 8 h mode; 63 | set_octal "owner" 108 8 h 0; 64 | set_octal "group" 116 8 h 0; 65 | set_octal "size" 124 12 h size; 66 | set_octal "mtime" 136 12 h mtime; 67 | set_string 148 h " "; (* Checksum *) 68 | set_string 156 h typeflag; 69 | set_string 257 h "ustar"; 70 | set_string 263 h "00"; 71 | set_octal "devmajor" 329 8 h 0; 72 | set_octal "devminor" 329 8 h 0; 73 | let c = header_checksum h in 74 | set_octal "checksum" 148 9 (* not NULL terminated *) h c; 75 | Ok (Bytes.unsafe_to_string h) 76 | with Failure msg -> R.error_msg msg 77 | 78 | (* Files *) 79 | 80 | let padding content = match String.length content mod 512 with 81 | | 0 -> "" 82 | | n -> Bytes.unsafe_to_string (Bytes.make (512 - n) '\x00') 83 | 84 | let add t fname ~mode ~mtime kind = 85 | let typeflag, size, data = match kind with 86 | | `Dir -> "5", 0, [] 87 | | `File cont -> "0", String.length cont, [cont; padding cont] 88 | in 89 | header fname mode mtime size typeflag 90 | >>| fun header -> List.rev_append data (header :: t) 91 | 92 | (* Encode *) 93 | 94 | let to_string t = 95 | let end_of_file = Bytes.unsafe_to_string (Bytes.make 1024 '\x00') in 96 | String.concat (List.rev (end_of_file :: t)) 97 | end 98 | 99 | let path_set_of_dir dir ~exclude_paths = 100 | let add_prefix p acc = Fpath.(Set.add (dir // p) acc) in 101 | let exclude_paths = Fpath.Set.(fold add_prefix exclude_paths empty) in 102 | let not_excluded p = Ok (not (Fpath.Set.mem p exclude_paths)) in 103 | let traverse = `Sat not_excluded in 104 | let elements = `Sat not_excluded in 105 | let err _ e = e in 106 | OS.Dir.fold_contents ~dotfiles:true ~err ~elements ~traverse 107 | Fpath.Set.add Fpath.Set.empty dir 108 | 109 | let tar dir ~exclude_paths ~root ~mtime = 110 | let tar_add file tar = 111 | let fname = match Fpath.rem_prefix dir file with 112 | | None -> assert false 113 | | Some file -> Fpath.(root // file) 114 | in 115 | Logs.info (fun m -> m "Archiving %a" Fpath.pp fname); 116 | tar 117 | >>= fun tar -> OS.Dir.exists file 118 | >>= function 119 | | true -> Tar.add tar fname ~mode:0o775 ~mtime `Dir 120 | | false -> 121 | OS.Path.Mode.get file 122 | >>= fun mode -> OS.File.read file 123 | >>= fun contents -> 124 | let mode = if 0o100 land mode > 0 then 0o775 else 0o664 in 125 | Tar.add tar fname ~mode ~mtime (`File contents) 126 | in 127 | path_set_of_dir dir ~exclude_paths 128 | >>= fun fset -> Fpath.Set.fold tar_add fset (Ok Tar.empty) 129 | >>| fun tar -> Tar.to_string tar 130 | 131 | (* Bzip2 compression and unarchiving *) 132 | 133 | let bzip2_cmd = OS.Env.(value "TOPKG_BZIP2" cmd ~absent:(Cmd.v "bzip2")) 134 | let ensure_bzip2 () = OS.Cmd.must_exist bzip2_cmd >>| fun _ -> () 135 | let bzip2 s ~dst = OS.Cmd.(in_string s |> run_io bzip2_cmd |> to_file dst) 136 | 137 | let tar_cmd = OS.Env.(value "TOPKG_TAR" cmd ~absent:(Cmd.v "tar")) 138 | let ensure_tar () = OS.Cmd.must_exist tar_cmd >>| fun _ -> () 139 | let untbz ?(clean = false) ar = 140 | let clean_dir dir = OS.Dir.exists dir >>= function 141 | | true when clean -> OS.Dir.delete ~recurse:true dir 142 | | _ -> Ok () 143 | in 144 | let archive_dir, ar = Fpath.split_base ar in 145 | let unarchive ar = 146 | let dir = Fpath.rem_ext ar in 147 | OS.Cmd.must_exist tar_cmd 148 | >>= fun cmd -> clean_dir dir 149 | >>= fun () -> OS.Cmd.run Cmd.(tar_cmd % "-xjf" % p ar) 150 | >>= fun () -> Ok Fpath.(archive_dir // dir) 151 | in 152 | R.join @@ OS.Dir.with_current archive_dir unarchive ar 153 | -------------------------------------------------------------------------------- /src-care/topkg_care_delegate.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Bos_setup 7 | 8 | (* Running the delegate *) 9 | 10 | let run_delegate pkg args = 11 | let verbosity = Logs.level_to_string (Logs.level ()) in 12 | Topkg_care_pkg.delegate pkg 13 | >>= fun del -> Ok Cmd.(del % "ipc" % verbosity %% args) 14 | >>= fun cmd -> OS.Cmd.run_status cmd 15 | >>= function 16 | | `Exited 0 -> Ok () 17 | | `Exited 1 -> 18 | R.error_msgf "Action unsupported by delegate %a" Cmd.pp del 19 | | (`Exited n | `Signaled n) -> 20 | R.error_msgf "Delegate %a errored with %d" Cmd.pp del n 21 | 22 | (* Publish request *) 23 | 24 | let publish_distrib p ~msg ~archive = 25 | Topkg_care_pkg.name p 26 | >>= fun name -> Topkg_care_pkg.version p 27 | >>= fun version -> Topkg_care_pkg.distrib_uri p 28 | >>= fun distrib_uri -> 29 | run_delegate p Cmd.(v "publish" % "distrib" % distrib_uri % 30 | name % version % msg % p archive) 31 | 32 | let publish_doc p ~msg ~docdir = 33 | let doc_uri p = Topkg_care_pkg.opam_field_hd p "doc" >>= function 34 | | None -> Ok "" 35 | | Some uri -> Ok uri 36 | in 37 | Topkg_care_pkg.name p 38 | >>= fun name -> Topkg_care_pkg.version p 39 | >>= fun version -> doc_uri p 40 | >>= fun doc_uri -> 41 | run_delegate p Cmd.(v "publish" % "doc" % doc_uri % name % version % msg % 42 | p docdir) 43 | 44 | let publish_alt p ~kind ~msg ~archive = 45 | Topkg_care_pkg.name p 46 | >>= fun name -> Topkg_care_pkg.version p 47 | >>= fun version -> Topkg_care_pkg.distrib_uri p 48 | >>= fun distrib_uri -> 49 | run_delegate p Cmd.(v "publish" % "alt" % distrib_uri % kind % 50 | name % version % msg % p archive) 51 | 52 | let publish_in_git_branch ~remote ~branch ~name ~version ~docdir ~dir = 53 | let pp_distrib ppf (name, version) = 54 | Fmt.pf ppf "%a %a" 55 | Topkg_care_text.Pp.name name Topkg_care_text.Pp.version version 56 | in 57 | let log_publish_result msg distrib dir = 58 | Logs.app (fun m -> m "%s %a@ in@ directory@ %a@ of@ gh-pages@ branch" 59 | msg pp_distrib distrib Fpath.pp dir) 60 | in 61 | let cp src dst = 62 | let dst_is_root = Fpath.is_current_dir dst in 63 | let src = 64 | if dst_is_root then Fpath.to_dir_path src else Fpath.rem_empty_seg src 65 | in 66 | (* FIXME we lost Windows friends here, fix bos #30 *) 67 | OS.Cmd.run Cmd.(v "cp" % "-R" % p src % p dst) 68 | in 69 | let delete dir = 70 | if not (Fpath.is_current_dir dir) then OS.Dir.delete ~recurse:true dir else 71 | let delete acc p = acc >>= fun () -> OS.Path.delete ~recurse:true p in 72 | let gitdir = Fpath.v ".git" in 73 | let not_git p = not (Fpath.equal p gitdir) in 74 | OS.Dir.contents dir 75 | >>= fun files -> List.fold_left delete (Ok ()) (List.filter not_git files) 76 | in 77 | let git_for_repo r = Cmd.of_list (Topkg.Cmd.to_list @@ Topkg.Vcs.cmd r) in 78 | let replace_dir_and_push docdir dir = 79 | let msg = strf "Update %s doc to %s." name version in 80 | Topkg.Vcs.get () 81 | >>= fun repo -> Ok (git_for_repo repo) 82 | >>= fun git -> OS.Cmd.run Cmd.(git % "checkout" % branch) 83 | >>= fun () -> delete dir 84 | >>= fun () -> cp docdir dir 85 | >>= fun () -> Topkg.Vcs.is_dirty repo 86 | >>= function 87 | | false -> Ok false 88 | | true -> 89 | OS.Cmd.run Cmd.(git % "add" % p dir) 90 | >>= fun () -> OS.Cmd.run Cmd.(git % "commit" % "-m" % msg) 91 | >>= fun () -> OS.Cmd.run Cmd.(git % "push") 92 | >>= fun () -> Ok true 93 | in 94 | if not (Fpath.is_rooted ~root:Fpath.(v ".") dir) 95 | then 96 | R.error_msgf "%a directory is not rooted in the repository or not relative" 97 | Fpath.pp dir 98 | else 99 | let clonedir = Fpath.(parent docdir / strf "%s-%s.pubdoc" name version) in 100 | OS.Dir.delete ~recurse:true clonedir 101 | >>= fun () -> Topkg.Vcs.get () 102 | >>= fun repo -> Topkg.Vcs.clone repo ~dir:(Fpath.to_string clonedir) 103 | >>= fun () -> OS.Dir.with_current clonedir (replace_dir_and_push docdir) dir 104 | >>= fun res -> res 105 | >>= function 106 | | false (* no changes *) -> 107 | log_publish_result "No documentation changes for" (name, version) dir; 108 | Ok () 109 | | true -> 110 | let push_spec = strf "%s:%s" branch branch in 111 | Ok (git_for_repo repo) >>= fun git -> 112 | OS.Cmd.run Cmd.(git % "push" % remote % push_spec) 113 | >>= fun () -> OS.Dir.delete ~recurse:true clonedir 114 | >>= fun () -> 115 | log_publish_result "Published documentation for" (name, version) dir; 116 | Ok () 117 | 118 | (* Issue requests *) 119 | 120 | let issues_uri p = Topkg_care_pkg.opam_field p "dev-repo" >>| function 121 | | None | Some [] -> "" 122 | | Some (u :: _) -> u 123 | 124 | let issue_list p = 125 | issues_uri p >>= fun issues_uri -> 126 | run_delegate p Cmd.(v "issue" % "list" % issues_uri) 127 | 128 | let issue_show p ~id = 129 | issues_uri p >>= fun issues_uri -> 130 | run_delegate p Cmd.(v "issue" % "show" % issues_uri % "id") 131 | 132 | let issue_open p ~title ~body = 133 | issues_uri p >>= fun issues_uri -> 134 | match run_delegate p Cmd.(v "issue" % "open" % issues_uri % title % body) with 135 | | Ok _ as v -> v 136 | | Error _ as e -> 137 | let pp_body ppf = function "" -> () | body -> Fmt.pf ppf "@,@,%s" body in 138 | Logs.app (fun m -> m "@[Your open issue message was:@,---@,%s%a@]" 139 | title pp_body body); 140 | e 141 | 142 | let issue_close p ~id ~msg = 143 | issues_uri p >>= fun issues_uri -> 144 | match run_delegate p Cmd.(v "issue" % "close" % issues_uri % id % msg) with 145 | | Ok _ as v -> v 146 | | Error _ as e -> 147 | Logs.app (fun m -> m "@[Your closing message was:@,---@,%s@]" msg); 148 | e 149 | -------------------------------------------------------------------------------- /src-care/topkg_care_text.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Bos_setup 7 | 8 | type flavour = [ `Markdown | `Asciidoc ] 9 | 10 | let flavour_of_fpath f = match String.Ascii.lowercase (Fpath.get_ext f) with 11 | | ".md" -> Some `Markdown 12 | | ".asciidoc" | ".adoc" -> Some `Asciidoc 13 | | _ -> None 14 | 15 | let rec drop_blanks = function "" :: ls -> drop_blanks ls | ls -> ls 16 | let last_line = function [] -> None | l :: rev_ls -> Some l 17 | 18 | (* Detecting headers *) 19 | 20 | let simple_header hchar l before rest = 21 | match String.(length @@ take ~sat:(Char.equal hchar) l) with 22 | | 0 -> None 23 | | n -> Some (n, l, before, rest) 24 | 25 | let underline_header n uchar l before rest = 26 | let is_underline_header uchar l = 27 | String.(length @@ take ~sat:(Char.equal uchar) l) >= 2 28 | in 29 | if not (is_underline_header uchar l) then None else 30 | match last_line before with 31 | | None -> None 32 | | Some t -> Some (n, strf "%s\n%s" t l, List.tl before, rest) 33 | 34 | let rec find_markdown_header before = function 35 | | [] -> None 36 | | l :: ls -> 37 | match simple_header '#' l before ls with 38 | | Some _ as h -> h 39 | | None -> 40 | match underline_header 1 '=' l before ls with 41 | | Some _ as h -> h 42 | | None -> 43 | match underline_header 2 '-' l before ls with 44 | | Some _ as h -> h 45 | | None -> find_markdown_header (l :: before) ls 46 | 47 | let rec find_asciidoc_header before = function 48 | | [] -> None 49 | | l :: ls -> 50 | match simple_header '=' l before ls with 51 | | Some _ as h -> h 52 | | None -> 53 | match underline_header 1 '-' l before ls with 54 | | Some _ as h -> h 55 | | None -> 56 | match underline_header 2 '~' l before ls with 57 | | Some _ as h -> h 58 | | None -> 59 | match underline_header 3 '^' l before ls with 60 | | Some _ as h -> h 61 | | None -> 62 | match underline_header 4 '+' l before ls with 63 | | Some _ as h -> h 64 | | None -> find_asciidoc_header (l :: before) ls 65 | 66 | let head find_header text = 67 | let lines = String.cuts ~sep:"\n" text in 68 | let ret h acc = 69 | let contents = String.concat ~sep:"\n" (List.rev @@ drop_blanks acc) in 70 | Some (h, contents) 71 | in 72 | match find_header [] lines with 73 | | None -> None 74 | | Some (n, first, _ (* discard *), rest) -> 75 | let rec loop acc rest = match find_header acc rest with 76 | | None -> ret first (List.rev_append rest acc) 77 | | Some (n', h, before, rest) -> 78 | if n' > n then loop (h :: before) rest else 79 | ret first before 80 | in 81 | loop [] rest 82 | 83 | let head ?(flavour = `Markdown) text = match flavour with 84 | | `Markdown -> head find_markdown_header text 85 | | `Asciidoc -> head find_asciidoc_header text 86 | 87 | let header_title ?(flavour = `Markdown) h = match String.cuts ~sep:"\n" h with 88 | | [h] -> 89 | begin match flavour with 90 | | `Markdown -> String.(trim @@ drop ~sat:(Char.equal '#') h) 91 | | `Asciidoc -> String.(trim @@ drop ~sat:(Char.equal '=') h) 92 | end 93 | | h :: _ -> h (* underline headers *) 94 | | [] -> assert false 95 | 96 | (* Toy change log parsing *) 97 | 98 | let change_log_last_entry ?flavour text = match head ?flavour text with 99 | | None -> None 100 | | Some (h, changes) -> 101 | let title = header_title ?flavour h in 102 | match String.take ~sat:Char.Ascii.is_graphic title with 103 | | "" -> Logs.app (fun m -> m "%S %S" h changes); None 104 | | version -> Some (version, (h, changes)) 105 | 106 | let change_log_file_last_entry file = 107 | let flavour = flavour_of_fpath file in 108 | OS.File.read file 109 | >>= fun text -> match change_log_last_entry ?flavour text with 110 | | None -> R.error_msgf "%a: Could not parse change log." Fpath.pp file 111 | | Some (version, (header, changes)) -> Ok (version, (header, changes)) 112 | 113 | (* Toy URI parsing *) 114 | 115 | let split_uri ?(rel = false) uri = match String.(cut ~sep:"//" (trim uri)) with 116 | | None -> None 117 | | Some (scheme, rest) -> 118 | match String.cut ~sep:"/" rest with 119 | | None -> Some (scheme, rest, "") 120 | | Some (host, path) -> 121 | let path = if rel then path else "/" ^ path in 122 | Some (scheme, host, path) 123 | 124 | (* Edit and page text *) 125 | 126 | let find_pager ~don't = 127 | if don't then Ok None else 128 | match OS.Env.var "TERM" with 129 | | Some "dumb" | None -> Ok None 130 | | _ -> 131 | let add_env v cmds = match OS.Env.(value v (some cmd) ~absent:None) with 132 | | None -> cmds 133 | | Some cmd -> cmd :: cmds 134 | in 135 | let cmds = [Cmd.v "less"; Cmd.v "more" ] in 136 | let cmds = add_env "PAGER" cmds in 137 | let rec loop = function 138 | | [] -> Ok None 139 | | cmd :: cmds -> 140 | OS.Cmd.exists cmd >>= function 141 | | true -> Ok (Some cmd) 142 | | false -> loop cmds 143 | in 144 | loop cmds 145 | 146 | let edit_file f = match OS.Env.(value "EDITOR" (some cmd) ~absent:None) with 147 | | None -> R.error_msg "EDITOR environment variable undefined." 148 | | Some editor -> 149 | OS.Cmd.exists editor >>= function 150 | | false -> R.error_msgf "Editor %a not in search path" Cmd.pp editor 151 | | true -> 152 | OS.Cmd.(run_status Cmd.(editor % p f)) >>= function 153 | | `Exited n | `Signaled n -> Ok n 154 | 155 | (* Pretty-printers. *) 156 | 157 | module Pp = struct 158 | let name = Fmt.(styled `Bold string) 159 | let version = Fmt.(styled `Cyan string) 160 | let commit = Fmt.(styled `Yellow string) 161 | let dirty = Fmt.(styled `Red (any "dirty")) 162 | let path = Fmt.(styled `Bold Fpath.pp) 163 | let status ppf = function 164 | | `Ok -> Fmt.(brackets @@ styled `Green (any " OK ")) ppf () 165 | | `Fail -> Fmt.(brackets @@ styled `Red (any "FAIL")) ppf () 166 | end 167 | -------------------------------------------------------------------------------- /src-bin/cli.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Bos_setup 7 | open Cmdliner 8 | 9 | (* Converters and arguments *) 10 | 11 | let path_arg = Arg.conv Fpath.(of_string, pp) 12 | 13 | let pkg_file = 14 | let doc = "Use $(docv) as the package description file." in 15 | let docv = "FILE" in 16 | Arg.(value & opt path_arg (Fpath.v "pkg/pkg.ml") & 17 | info ["pkg-file"] ~docs:Manpage.s_common_options ~doc ~docv) 18 | 19 | let pkg_name = 20 | let doc = "The name $(docv) of the opam package. If absent provided 21 | by the package description." 22 | in 23 | let docv = "PKG_NAME" in 24 | Arg.(value & opt (some string) None & info ["n"; "pkg-name"] ~doc ~docv) 25 | 26 | let opam = 27 | let doc = "The opam file to use. If absent uses the default opam file 28 | mentioned in the package description." 29 | in 30 | let docv = "FILE" in 31 | Arg.(value & opt (some path_arg) None & info ["opam"] ~doc ~docv) 32 | 33 | let dist_name = 34 | let doc = "The name $(docv) of the package to use for the package 35 | distribution. If absent, provided by the package description." 36 | in 37 | let docv = "NAME" in 38 | Arg.(value & opt (some string) None & info ["dist-name"] ~doc ~docv) 39 | 40 | let dist_version = 41 | let doc = "The version string to use for the package distribution. 42 | If absent, provided by the VCS tag description of the 43 | HEAD commit." 44 | in 45 | let docv = "VERSION" in 46 | Arg.(value & opt (some string) None & info ["dist-version"] ~doc ~docv) 47 | 48 | let dist_file = 49 | let doc = "The package distribution archive. If absent the file 50 | $(i,BUILD_DIR)/$(i,NAME)-$(i,VERSION).tbz (see options 51 | $(b,--build-dir), $(b,--dist-name) and $(b,--dist-version))." 52 | in 53 | let docv = "FILE" in 54 | Arg.(value & opt (some path_arg) None & info ["dist-file"] ~doc ~docv) 55 | 56 | let dist_opam = 57 | let doc = "opam file to use for the distribution. If absent uses the opam 58 | file mentioned in the package description that corresponds to 59 | the distribution package name $(i,NAME) (see option 60 | $(b,--dist-name))." 61 | in 62 | let docv = "FILE" in 63 | Arg.(value & opt (some path_arg) None & info ["dist-opam"] ~doc ~docv) 64 | 65 | let dist_uri = 66 | let doc = "The distribution archive URI on the WWW. If absent, provided by the 67 | package description." 68 | in 69 | let docv = "URI" in 70 | Arg.(value & opt (some string) None & info ["dist-uri"] ~doc ~docv) 71 | 72 | let readme = 73 | let doc = "The readme to use. If absent, provided by the package 74 | description." 75 | in 76 | let docv = "FILE" in 77 | Arg.(value & opt (some path_arg) None & info ["readme"] ~doc ~docv) 78 | 79 | let change_log = 80 | let doc = "The change log to use. If absent, provided by the package 81 | description." 82 | in 83 | let docv = "FILE" in 84 | Arg.(value & opt (some path_arg) None & info ["change-log"] ~doc ~docv) 85 | 86 | let delegate = 87 | let doc = "The delegate tool $(docv) to use. If absent, see topkg-delegate(7) 88 | for the lookup procedure." 89 | in 90 | let docv = "TOOL" in 91 | let to_cmd = function None -> None | Some s -> Some (Bos.Cmd.v s) in 92 | Term.(const to_cmd $ 93 | Arg.(value & opt (some string) None & info ["delegate"] ~doc ~docv)) 94 | 95 | let build_dir = 96 | let doc = "Specifies the build directory $(docv). If absent, provided by the 97 | package description." 98 | in 99 | let docv = "BUILD_DIR" in 100 | Arg.(value & opt (some path_arg) None & info ["build-dir"] ~doc ~docv) 101 | 102 | let publish_msg = 103 | let doc = "The publication message $(docv). Defaults to the change 104 | log of the last version (see $(b,topkg log -l))." 105 | in 106 | let docv = "MSG" in 107 | Arg.(value & opt (some string) None & info ["m"; "message"] ~doc ~docv) 108 | 109 | (* Terms *) 110 | 111 | let logs_to_topkg_log_level = function 112 | | None -> None 113 | | Some Logs.App -> Some (Topkg.Log.App) 114 | | Some Logs.Error -> Some (Topkg.Log.Error) 115 | | Some Logs.Warning -> Some (Topkg.Log.Warning) 116 | | Some Logs.Info -> Some (Topkg.Log.Info) 117 | | Some Logs.Debug -> Some (Topkg.Log.Debug) 118 | 119 | let setup style_renderer log_level cwd = 120 | Fmt_tty.setup_std_outputs ?style_renderer (); 121 | Topkg.Log.set_level (logs_to_topkg_log_level log_level); 122 | Logs.set_level log_level; 123 | Logs.set_reporter (Logs_fmt.reporter ~app:Fmt.stdout ()); 124 | Logs.info (fun m -> m "topkg %%VERSION%% running"); 125 | match cwd with 126 | | None -> `Ok () 127 | | Some dir -> 128 | match OS.Dir.set_current dir with 129 | | Ok () -> `Ok () 130 | | Error (`Msg m) -> `Error (false, m) (* use cmdliner evaluation error *) 131 | 132 | let setup = 133 | let style_renderer = 134 | let env = Cmd.Env.info "TOPKG_COLOR" in 135 | Fmt_cli.style_renderer ~docs:Manpage.s_common_options ~env () 136 | in 137 | let log_level = 138 | let env = Cmd.Env.info "TOPKG_VERBOSITY" in 139 | Logs_cli.level ~docs:Manpage.s_common_options ~env () 140 | in 141 | let cwd = 142 | let doc = "Change to directory $(docv) before doing anything." in 143 | let docv = "DIR" in 144 | Arg.(value & opt (some path_arg) None & info ["C"; "pkg-dir"] 145 | ~docs:Manpage.s_common_options ~doc ~docv) 146 | in 147 | Term.(ret (const setup $ style_renderer $ log_level $ cwd)) 148 | 149 | (* Verbosity propagation. *) 150 | 151 | let propagate_verbosity_to_pkg_file () = match Logs.level () with 152 | | None -> Bos.Cmd.(v "-q") 153 | | Some Logs.Info -> Bos.Cmd.(v "-v") 154 | | Some Logs.Debug -> Bos.Cmd.(v "-v" % "-v") 155 | | Some _ -> Bos.Cmd.empty 156 | 157 | (* Error handling *) 158 | 159 | let warn_if_vcs_dirty msg = 160 | Topkg.Vcs.get () 161 | >>= fun repo -> Topkg.Vcs.is_dirty repo 162 | >>= function 163 | | false -> Ok () 164 | | true -> 165 | Logs.warn 166 | (fun m -> m "The repo is %a. %a" Topkg_care.Pp.dirty () Fmt.text msg); 167 | Ok () 168 | 169 | let handle_error = function 170 | | Ok 0 -> if Logs.err_count () > 0 then 3 else 0 171 | | Ok n -> n 172 | | Error _ as r -> Logs.on_error_msg ~use:(fun _ -> 3) r 173 | 174 | let exits = 175 | Cmd.Exit.info 3 ~doc:"on indiscriminate errors reported on stderr." :: 176 | Cmd.Exit.defaults 177 | -------------------------------------------------------------------------------- /src-care/topkg_care_opam.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Bos_setup 7 | 8 | (* Command *) 9 | 10 | let cmd = 11 | Cmd.of_list @@ Topkg.Cmd.to_list @@ Topkg.Conf.tool "opam" `Host_os 12 | 13 | (* Publish *) 14 | 15 | let publish = 16 | let absent = Cmd.(v "opam-publish") in 17 | OS.Env.(value "TOPKG_OPAM_PUBLISH" cmd ~absent) 18 | 19 | let ensure_publish () = 20 | OS.Cmd.must_exist publish >>= fun cmd -> 21 | OS.Cmd.run_out Cmd.(publish % "--version") |> OS.Cmd.out_string 22 | >>= fun (version, _) -> match Topkg.String.parse_version version with 23 | | None -> R.error_msgf "Could not determine the version of opam-publish" 24 | | Some (m, _, _, _) when m < 2 -> 25 | R.error_msgf "topkg needs at least opam-publish 2.0.0" 26 | | Some _ -> Ok () 27 | 28 | let submit ?msg ~opam_file () = 29 | let msg = match msg with 30 | | None -> Ok (Cmd.empty) 31 | | Some msg -> 32 | OS.File.tmp "topkg-opam-submit-msg-%s" 33 | >>= fun m -> OS.File.write m msg 34 | >>= fun () -> Ok Cmd.(v "--msg-file" % p m) 35 | in 36 | msg >>= fun msg -> OS.Cmd.run Cmd.(publish %% msg % p opam_file) 37 | 38 | (* Packages *) 39 | 40 | let ocaml_base_packages = String.Set.of_list 41 | [ "base-bigarray"; "base-bytes"; "base-threads"; "base-unix"; ] 42 | 43 | (* Files *) 44 | 45 | module File = struct 46 | 47 | (* Try to compose with the OpamFile.OPAM API *) 48 | 49 | let id x = x 50 | let list f = fun v -> [f v] 51 | let field name field conv = 52 | name, fun acc o -> String.Map.add name (conv (field o)) acc 53 | 54 | let opt_field name field conv = 55 | name, fun acc o -> match field o with 56 | | None -> acc 57 | | Some v -> String.Map.add name (conv v) acc 58 | 59 | let deps_conv d = 60 | let add_pkg acc (n, _) = OpamPackage.Name.to_string n :: acc in 61 | OpamFormula.fold_left add_pkg [] d 62 | 63 | let fields = [ 64 | opt_field "name" OpamFile.OPAM.name_opt (list OpamPackage.Name.to_string); 65 | opt_field "version" OpamFile.OPAM.version_opt 66 | (list OpamPackage.Version.to_string); 67 | field "opam-version" OpamFile.OPAM.opam_version 68 | (list OpamVersion.to_string); 69 | field "available" OpamFile.OPAM.available (list OpamFilter.to_string); 70 | field "maintainer" OpamFile.OPAM.maintainer id; 71 | field "homepage" OpamFile.OPAM.homepage id; 72 | field "authors" OpamFile.OPAM.author id; 73 | field "license" OpamFile.OPAM.license id; 74 | field "doc" OpamFile.OPAM.doc id; 75 | field "tags" OpamFile.OPAM.tags id; 76 | field "bug-reports" OpamFile.OPAM.bug_reports id; 77 | opt_field "dev-repo" OpamFile.OPAM.dev_repo (list OpamUrl.to_string); 78 | field "depends" OpamFile.OPAM.depends deps_conv; 79 | field "depopts" OpamFile.OPAM.depopts deps_conv; 80 | opt_field "synopsis" OpamFile.OPAM.synopsis (list id); 81 | opt_field "description" OpamFile.OPAM.descr_body (list id); 82 | ] 83 | 84 | let field_names = 85 | let add acc (name, field) = String.Set.add name acc in 86 | List.fold_left add String.Set.empty fields 87 | 88 | let fields file = 89 | let parse file = 90 | let file = OpamFilename.of_string (Fpath.to_string file) in 91 | let opam = OpamFile.OPAM.read (OpamFile.make file) in 92 | let known_fields = 93 | let add_field acc (_, field) = field acc opam in 94 | List.fold_left add_field String.Map.empty fields 95 | in 96 | (* FIXME add OpamFile.OPAM.extensions when supported *) 97 | known_fields 98 | in 99 | Logs.info (fun m -> m "Parsing opam file %a" Fpath.pp file); 100 | try Ok (parse file) with 101 | | exn -> 102 | (* Apparently in at least opam-lib 1.2.2, the error will be logged 103 | on stdout. *) 104 | R.error_msgf "%a: could not parse opam file" Fpath.pp file 105 | 106 | let deps ?(opts = true) fields = 107 | let deps = match String.Map.find "depends" fields with 108 | | None -> [] | Some deps -> deps 109 | in 110 | let dep_opts = 111 | if not opts then [] else 112 | match String.Map.find "depopts" fields with 113 | | None -> [] | Some deps -> deps 114 | in 115 | String.Set.of_list (List.rev_append dep_opts deps) 116 | end 117 | 118 | module Descr = struct 119 | type t = string * string 120 | 121 | let of_string s = match String.cuts ~sep:"\n" s with 122 | | [] -> R.error_msgf "Cannot extract opam descr." 123 | | synopsis :: descr -> Ok (synopsis, String.concat ~sep:"\n" descr) 124 | 125 | let to_string (synopsis, descr) = strf "%s\n%s" synopsis descr 126 | let to_opam_fields (synopsis, descr) = 127 | strf "synopsis: \"\"\"%s\"\"\"\ndescription: \"\"\"\\\n%s\"\"\"" 128 | synopsis descr 129 | 130 | let of_readme ?flavour r = 131 | let parse_synopsis l = 132 | let error l = R.error_msgf "%S: can't extract opam synopsis" l in 133 | let ok s = Ok String.(Ascii.capitalize @@ String.Sub.to_string s) in 134 | let not_white c = not (Char.Ascii.is_white c) in 135 | let skip_non_white l = String.Sub.drop ~sat:not_white l in 136 | let skip_white l = String.Sub.drop ~sat:Char.Ascii.is_white l in 137 | let start = 138 | String.sub l |> skip_white |> skip_non_white |> skip_white 139 | in 140 | match String.Sub.head start with 141 | | None -> error l 142 | | Some c when Char.Ascii.is_letter c -> ok start 143 | | Some c -> (* Try to skip a separator. *) 144 | let start = start |> skip_non_white |> skip_white in 145 | match String.Sub.head start with 146 | | None -> error l 147 | | Some _ -> ok start 148 | in 149 | let drop_line l = 150 | String.is_prefix ~affix:"Home page:" l || 151 | String.is_prefix ~affix:"Homepage:" l || 152 | String.is_prefix ~affix:"Contact:" l || 153 | String.is_prefix ~affix:"%%VERSION" l 154 | in 155 | let keep_line l = not (drop_line l) in 156 | match Topkg_care_text.head ?flavour r with 157 | | None -> R.error_msgf "Could not extract opam description." 158 | | Some (title, text) -> 159 | let sep = "\n" in 160 | let title = Topkg_care_text.header_title ?flavour title in 161 | parse_synopsis title 162 | >>= fun synopsis -> Ok (String.cuts ~sep text) 163 | >>= fun text -> Ok (List.filter keep_line text) 164 | >>= fun text -> Ok (synopsis, String.concat ~sep text) 165 | 166 | let of_readme_file file = 167 | let flavour = Topkg_care_text.flavour_of_fpath file in 168 | (OS.File.read file 169 | >>= fun text -> of_readme ?flavour text) 170 | |> R.reword_error_msg ~replace:true 171 | (fun m -> R.msgf "%a: %s" Fpath.pp file m) 172 | end 173 | 174 | module Url = struct 175 | type t = string 176 | let v ~uri ~checksum = strf "archive: \"%s\"\nchecksum: \"%s\"" uri checksum 177 | let with_distrib_file ~uri distrib_file = 178 | try 179 | let checksum = Digest.(to_hex @@ file (Fpath.to_string distrib_file)) in 180 | Ok (v ~uri ~checksum) 181 | with Failure msg | Sys_error msg -> R.error_msg msg 182 | 183 | let to_opam_section u = strf "url {\n%s\n}" u 184 | end 185 | -------------------------------------------------------------------------------- /src-bin/distrib.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Bos_setup 7 | 8 | let lint_distrib pkg ~dir = 9 | Logs.app (fun m -> m "@.Linting distrib in %a" Fpath.pp dir); 10 | Topkg_care.Pkg.lint pkg ~dir Topkg_care.Pkg.lint_all 11 | 12 | let build_distrib pkg ~dir skip_tests = 13 | Logs.app (fun m -> m "@.Building package in %a" Fpath.pp dir); 14 | let tests = if skip_tests then Cmd.empty else Cmd.(v "--tests" % "true") in 15 | let args = Cmd.(v "--dev-pkg" % "false" % "--vcs" % "false" %% tests) in 16 | let out = OS.Cmd.out_string in 17 | Topkg_care.Pkg.build pkg ~dir ~args ~out >>= function 18 | | (_, (_, `Exited 0)) -> 19 | Logs.app (fun m -> m "%a package builds" Topkg_care.Pp.status `Ok); Ok 0 20 | | (stdout, _) -> 21 | Logs.app (fun m -> m "%s@\n%a package builds" 22 | stdout Topkg_care.Pp.status `Fail); Ok 1 23 | 24 | let test_distrib pkg ~dir = 25 | Logs.app (fun m -> m "@.Running package tests in %a" Fpath.pp dir); 26 | let out = OS.Cmd.out_string in 27 | Topkg_care.Pkg.test pkg ~dir ~args:Cmd.empty ~out >>= function 28 | | (_, (_, `Exited 0)) -> 29 | Logs.app (fun m -> m "%a package tests" 30 | Topkg_care.Pp.status `Ok); Ok 0 31 | | (stdout, _) -> 32 | Logs.app (fun m -> m "%s@\n%a package tests" 33 | stdout Topkg_care.Pp.status `Fail); Ok 1 34 | 35 | let check_archive pkg ar ~skip_lint ~skip_build ~skip_tests = 36 | Topkg_care.Archive.untbz ~clean:true ar 37 | >>= fun dir -> (if skip_lint then Ok 0 else lint_distrib pkg ~dir) 38 | >>= fun c0 -> (if skip_build then Ok 0 else build_distrib pkg ~dir skip_tests) 39 | >>= fun c1 -> (if skip_tests || skip_build then Ok 0 else 40 | test_distrib pkg ~dir) 41 | >>= fun c2 -> match c0 + c1 + c2 with 42 | | 0 -> OS.Dir.delete ~recurse:true dir >>= fun () -> Ok 0 43 | | n -> Ok 1 44 | 45 | let warn_if_vcs_dirty ()= 46 | Cli.warn_if_vcs_dirty "The distribution archive may be inconsistent." 47 | 48 | let log_footprint pkg archive = 49 | Topkg_care.Pkg.name pkg 50 | >>= fun name -> Topkg_care.Pkg.version pkg 51 | >>= fun version -> Topkg.Vcs.get () 52 | >>= fun repo -> Topkg.Vcs.commit_id repo ~dirty:false ~commit_ish:"HEAD" 53 | >>= fun commit_ish -> 54 | Logs.app 55 | (fun m -> m "@.@[@[Distribution for %a@ %a@]@,@[Commit %a@]@,\ 56 | @[Archive %a@]@]" 57 | Topkg_care.Pp.name name Topkg_care.Pp.version version 58 | Topkg_care.Pp.commit commit_ish Topkg_care.Pp.path archive); 59 | Ok () 60 | 61 | let log_wrote_archive ar = 62 | Logs.app (fun m -> m "Wrote archive %a" Topkg_care.Pp.path ar); Ok () 63 | 64 | let distrib 65 | () pkg_file opam build_dir name version keep_dir skip_lint skip_build 66 | skip_tests 67 | = 68 | begin 69 | let pkg = Topkg_care.Pkg.v ?name ?version ?build_dir ?opam pkg_file in 70 | Topkg_care.Pkg.distrib_archive pkg ~keep_dir 71 | >>= fun ar -> log_wrote_archive ar 72 | >>= fun () -> check_archive pkg ar ~skip_lint ~skip_build ~skip_tests 73 | >>= fun errs -> log_footprint pkg ar 74 | >>= fun () -> warn_if_vcs_dirty () 75 | >>= fun () -> Ok errs 76 | end 77 | |> Cli.handle_error 78 | 79 | (* Command line interface *) 80 | 81 | open Cmdliner 82 | 83 | let keep_build_dir = 84 | let doc = "Keep the distribution build directory after successful archival." 85 | in 86 | Arg.(value & flag & info ["keep-build-dir"] ~doc) 87 | 88 | let skip_lint = 89 | let doc = "Do not lint the archive distribution." in 90 | Arg.(value & flag & info ["skip-lint"] ~doc) 91 | 92 | let skip_build = 93 | let doc = "Do not try to build the package from the archive." in 94 | Arg.(value & flag & info ["skip-build"] ~doc) 95 | 96 | let skip_tests = 97 | let doc = "Do not try to build and run the package tests from the archive. 98 | Implied by $(b,--skip-build)." 99 | in 100 | Arg.(value & flag & info ["skip-tests"] ~doc) 101 | 102 | let doc = "Create a package distribution archive" 103 | let sdocs = Manpage.s_common_options 104 | let exits = Cli.exits 105 | let envs = 106 | [ Cmd.Env.info "TOPKG_BZIP2" ~doc:"The $(b,bzip2) tool to use to compress the 107 | archive. Gets the archive on stdin and must output the result on 108 | standard out."; 109 | Cmd.Env.info "TOPKG_TAR" ~doc:"The $(b,tar) tool to use to unarchive a tbz 110 | archive (archive creation itself is handled by topkg)."; ] 111 | 112 | let man_xrefs = [ `Main ] 113 | let man = 114 | [ `S Manpage.s_description; 115 | `P "The $(tname) command creates a package distribution 116 | archive in the build directory of the package. The generated 117 | archive should be bit-wise reproducible. There are however a few 118 | caveats, see the section about this further down."; 119 | `P "More detailed information about the archive creation process and its 120 | customization can be found in topkg's API documentation."; 121 | `P "Once the archive is created it is unpacked in the build directory, 122 | linted and the package is built using the package description 123 | contained in the archive. The build will use the default package 124 | configuration so it may fail in the current environment 125 | without this necessarily implying an actual problem with the 126 | distribution; one should still worry about it though. 127 | These checks can be prevented by using the $(b,--skip-lint) and 128 | $(b,--skip-build) options."; 129 | `S "REPRODUCIBLE DISTRIBUTION ARCHIVES"; 130 | `P "Given the package name, the HEAD commit identifier 131 | and the version string, the $(tname) command should always 132 | generate the same archive."; 133 | `P "More precisely, files are added to the archive using a well 134 | defined order on path names. Their file permissions are either 135 | 0o775 for directories and files that are executable for the user 136 | in the HEAD repository checkout or 0o664 for those that are not. 137 | Their modification times are set to the commit date (note that if 138 | git is used, git-log(1) shows the author date which may not 139 | coincide). No other file metadata is recorded."; 140 | `P "This should ensure that the resulting archive is bit-wise 141 | identical regardless of the context in which it is 142 | created. However this may fail for one or more of the 143 | following reasons:"; 144 | `I ("Non-reproducible distribution massage", "The package 145 | distribution massaging hook relies on external factors 146 | that are not captured by the source repository checkout. 147 | For example external data files, environment variables, etc."); 148 | `I ("File paths with non US-ASCII characters", 149 | "If these paths are encoded in UTF-8, different file systems 150 | may return the paths with different Unicode normalization 151 | forms which could yield different byte serializations in the 152 | archive (note that this could be lifted at the cost of a 153 | dependency on Uunf)."); 154 | `I ("The bzip2 utility", "The archive is compressed using the bzip2 utility. 155 | Reproducibility relies on bzip2 to be a reproducible function 156 | across platforms."); 157 | `I ("Topkg changes", "Topkg could change its distribution procedure in 158 | the future, for example to correct bugs."); ] 159 | 160 | let cmd = 161 | Cmd.v (Cmd.info "distrib" ~doc ~sdocs ~exits ~envs ~man ~man_xrefs) @@ 162 | Term.(const distrib $ Cli.setup $ Cli.pkg_file $ Cli.dist_opam $ 163 | Cli.build_dir $ Cli.dist_name $ Cli.dist_version $ keep_build_dir $ 164 | skip_lint $ skip_build $ skip_tests) 165 | -------------------------------------------------------------------------------- /src/topkg_codec.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Topkg_result 7 | 8 | (* Decode errors *) 9 | 10 | type error = Corrupted of (string * string) | Version of int * int 11 | 12 | let pp_error ppf = function 13 | | Corrupted (kind, v) -> 14 | Format.fprintf ppf "corrupted %s in %S" kind v 15 | | Version (exp, fnd) -> 16 | Format.fprintf ppf "version mismatch, expected %d found %d" exp fnd 17 | 18 | exception Error of error 19 | 20 | let err ~kind v = raise (Error (Corrupted (kind, v))) 21 | let err_version ~exp ~fnd = raise (Error (Version (exp, fnd))) 22 | 23 | (* Codecs *) 24 | 25 | type 'a t = 26 | { kind : string; 27 | enc : 'a -> string; 28 | dec : string -> 'a; } 29 | 30 | let v ~kind ~enc ~dec = { kind; enc; dec } 31 | let kind c = c.kind 32 | let enc c = c.enc 33 | let dec c = c.dec 34 | let with_kind kind c = { c with kind } 35 | 36 | let dec_result c s = try Ok (dec c s) with 37 | | Error err -> 38 | R.error_msgf "Decode %s: %a Input data: %S" (kind c) pp_error err s 39 | 40 | let write file c v = 41 | Topkg_os.File.write file (enc c v) 42 | |> R.reword_error_msg ~replace:true 43 | (fun err -> R.msgf "Encode %s to %s: %s" (kind c) file err) 44 | 45 | let read file c = 46 | Topkg_os.File.read file >>= fun s -> 47 | try Ok (dec c s) with 48 | | Error e -> R.error_msgf "Decode %s from %s: %a" (kind c) file pp_error e 49 | 50 | (* Base type codecs *) 51 | 52 | let tail s = Topkg_string.with_index_range ~first:1 s 53 | 54 | let unit = 55 | let kind = "unit" in 56 | let enc = function () -> "\x00" in 57 | let dec = function "\x00" -> () | s -> err ~kind s in 58 | v ~kind ~enc ~dec 59 | 60 | let const c = 61 | let kind = "const" in 62 | let enc = function _ -> "" in 63 | let dec = function "" -> c | s -> err ~kind s in 64 | v ~kind ~enc ~dec 65 | 66 | let bool = 67 | let kind = "bool" in 68 | let enc = function false -> "\x00" | true -> "\x01" in 69 | let dec = function "\x00" -> false | "\x01" -> true | s -> err ~kind s in 70 | v ~kind ~enc ~dec 71 | 72 | let int = 73 | let kind = "int" in 74 | let enc = string_of_int (* will do for now *) in 75 | let dec s = try int_of_string s with Failure _ -> err ~kind s in 76 | v ~kind ~enc ~dec 77 | 78 | let string = 79 | let kind = "string" in 80 | let enc s = s in 81 | let dec s = s in 82 | v ~kind ~enc ~dec 83 | 84 | let option some = 85 | let kind = Printf.sprintf "(%s) option" (kind some) in 86 | let enc = function None -> "\x00" | Some v -> "\x01" ^ (enc some v) in 87 | let dec s = match Topkg_string.head s with 88 | | Some '\x00' -> None 89 | | Some '\x01' -> Some (dec some (tail s)) 90 | | _ -> err ~kind s 91 | in 92 | v ~kind ~enc ~dec 93 | 94 | let result ~ok ~error = 95 | let kind = Printf.sprintf "(%s, %s) result" (kind ok) (kind error) in 96 | let enc = function 97 | | Ok v -> "\x00" ^ (enc ok v) 98 | | Error e -> "\x01" ^ (enc error e) 99 | in 100 | let dec s = match Topkg_string.head s with 101 | | Some '\x00' -> Ok (dec ok (tail s)) 102 | | Some '\x01' -> Error (dec error (tail s)) 103 | | _ -> err ~kind s 104 | in 105 | v ~kind ~enc ~dec 106 | 107 | let list el = 108 | let kind = Printf.sprintf "(%s) list" (kind el) in 109 | let enc vs = 110 | let b = Buffer.create 255 in 111 | let rec loop = function 112 | | [] -> Buffer.add_char b '\x00' 113 | | v :: vs -> 114 | let venc = (enc el) v in 115 | let venc_len = String.length venc in 116 | Buffer.add_char b '\x01'; 117 | Buffer.add_string b (string_of_int venc_len) (* will do for now *); 118 | Buffer.add_char b '\x01'; 119 | Buffer.add_string b venc; 120 | loop vs 121 | in 122 | loop vs; Buffer.contents b 123 | in 124 | let dec s = 125 | let rec loop acc s = match Topkg_string.head s with 126 | | Some '\x00' -> acc 127 | | Some '\x01' -> 128 | begin match Topkg_string.find_byte ~start:1 '\x01' s with 129 | | None -> err ~kind s 130 | | Some one -> 131 | try 132 | let last = one - 1 in 133 | let len = Topkg_string.with_index_range ~first:1 ~last s in 134 | let len = int_of_string len in 135 | let first = one + 1 in 136 | let last = first + len - 1 in 137 | let venc = Topkg_string.with_index_range ~first ~last s in 138 | let rest = Topkg_string.with_index_range ~first:(last + 1) s in 139 | loop ((dec el venc) :: acc) rest 140 | with Failure _ (* of int_of_string *) -> err ~kind s 141 | end 142 | | _ -> err ~kind s 143 | in 144 | List.rev (loop [] s) 145 | in 146 | v ~kind ~enc ~dec 147 | 148 | let seq = list string 149 | 150 | let pair c0 c1 = 151 | let kind = Printf.sprintf "%s * %s" (kind c0) (kind c1) in 152 | let enc (v0, v1) = enc seq [enc c0 v0; enc c1 v1] in 153 | let dec s = match dec seq s with 154 | | [lenc; renc] -> (dec c0 lenc), (dec c1 renc) 155 | | _ -> err ~kind s 156 | in 157 | v ~kind ~enc ~dec 158 | 159 | let t2 = pair 160 | 161 | let t3 c0 c1 c2 = 162 | let kind = Printf.sprintf "%s * %s * %s" (kind c0) (kind c1) (kind c2) in 163 | let seq = list string in 164 | let enc (v0, v1, v2) = enc seq [enc c0 v0; enc c1 v1; enc c2 v2] in 165 | let dec s = match (dec seq) s with 166 | | [v0; v1; v2] -> (dec c0 v0), (dec c1 v1), (dec c2 v2) 167 | | _ -> err ~kind s 168 | in 169 | v ~kind ~enc ~dec 170 | 171 | let t4 c0 c1 c2 c3 = 172 | let kind = 173 | Printf.sprintf "%s * %s * %s * %s" (kind c0) (kind c1) (kind c2) (kind c3) 174 | in 175 | let seq = list string in 176 | let enc (v0, v1, v2, v3) = 177 | enc seq [enc c0 v0; enc c1 v1; enc c2 v2; enc c3 v3] 178 | in 179 | let dec s = match (dec seq) s with 180 | | [v0; v1; v2; v3] -> (dec c0 v0), (dec c1 v1), (dec c2 v2), (dec c3 v3) 181 | | _ -> err ~kind s 182 | in 183 | v ~kind ~enc ~dec 184 | 185 | let t5 c0 c1 c2 c3 c4 = 186 | let kind = 187 | Printf.sprintf "%s * %s * %s * %s * %s" 188 | (kind c0) (kind c1) (kind c2) (kind c3) (kind c4) 189 | in 190 | let seq = list string in 191 | let enc (v0, v1, v2, v3, v4) = 192 | enc seq [enc c0 v0; enc c1 v1; enc c2 v2; enc c3 v3; enc c4 v4] 193 | in 194 | let dec s = match (dec seq) s with 195 | | [v0; v1; v2; v3; v4] -> 196 | (dec c0 v0), (dec c1 v1), (dec c2 v2), (dec c3 v3), (dec c4 v4) 197 | | _ -> err ~kind s 198 | in 199 | v ~kind ~enc ~dec 200 | 201 | let alt ~kind tag cs = 202 | let l = Array.length cs in 203 | if l > 256 then invalid_arg @@ Topkg_string.strf "too many codecs (%d)" l; 204 | let enc v = 205 | let tag = tag v in 206 | Printf.sprintf "%c%s" (Char.chr tag) (enc cs.(tag) v) 207 | in 208 | let dec s = match Topkg_string.head s with 209 | | None -> err ~kind s 210 | | Some tag -> 211 | let tag = Char.code tag in 212 | if tag < Array.length cs then dec cs.(tag) (tail s) else 213 | err ~kind s 214 | in 215 | v ~kind ~enc ~dec 216 | 217 | let version version = 218 | let enc_version = string_of_int version in 219 | fun c -> 220 | let kind = Printf.sprintf "(%s) v%s" (kind c) enc_version in 221 | let enc v = String.concat "\x00" [enc_version; enc c v] in 222 | let dec s = match Topkg_string.cut ~sep:'\x00' s with 223 | | None -> err ~kind s 224 | | Some (fnd_version, s) -> 225 | try 226 | let fnd = int_of_string fnd_version in 227 | if fnd <> version then err_version ~exp:version ~fnd else 228 | dec c s 229 | with 230 | | Failure _ (* of int_of_string *) -> err ~kind s 231 | in 232 | v ~kind ~enc ~dec 233 | 234 | let view ?kind:k (inj, proj) c = 235 | let kind = match k with None -> kind c | Some k -> k in 236 | let enc v = enc c (inj v) in 237 | let dec s = proj (dec c s) in 238 | v ~kind ~enc ~dec 239 | 240 | let msg = 241 | let msg = (fun (`Msg m) -> m), (fun m -> `Msg m) in 242 | view msg string 243 | 244 | let result_error_msg ok = result ~ok ~error:msg 245 | let fpath = string 246 | let cmd = 247 | let cmd = 248 | (fun cmd -> Topkg_cmd.to_list cmd), 249 | (fun l -> Topkg_cmd.of_list l) 250 | in 251 | view cmd (list string) 252 | -------------------------------------------------------------------------------- /src-bin/opam.ml: -------------------------------------------------------------------------------- 1 | (*--------------------------------------------------------------------------- 2 | Copyright (c) 2016 Daniel C. Bünzli. All rights reserved. 3 | SPDX-License-Identifier: ISC 4 | ---------------------------------------------------------------------------*) 5 | 6 | open Bos_setup 7 | 8 | let get_opam_publish_file p opam_publish_file = match opam_publish_file with 9 | | Some file -> Ok file 10 | | None -> 11 | Topkg_care.Pkg.build_dir p 12 | >>= fun bdir -> Topkg_care.Pkg.distrib_filename ~opam:true p 13 | >>= fun fname -> Ok Fpath.(bdir // fname + ".opam") 14 | 15 | let descr pkg = 16 | Topkg_care.Pkg.opam_descr pkg >>= fun (descr, _) -> 17 | Logs.app (fun m -> m "%s" (Topkg_care.Opam.Descr.to_string descr)); 18 | Ok 0 19 | 20 | let pkg pkg dist_pkg opam_publish_file = 21 | let log_pkg dst = 22 | Logs.app (fun m -> m "Wrote opam package %a" Topkg_care.Pp.path dst) 23 | in 24 | let warn_if_vcs_dirty () = 25 | Cli.warn_if_vcs_dirty "The opam package may be inconsistent with the \ 26 | distribution." 27 | in 28 | let opam_file_content opam (descr, from_opam) url = 29 | let descr = 30 | if from_opam then "" else 31 | (Topkg_care.Opam.Descr.to_opam_fields descr ^ "\n") 32 | in 33 | strf "%s\n%s%s" opam descr (Topkg_care.Opam.Url.to_opam_section url) 34 | in 35 | get_opam_publish_file pkg opam_publish_file 36 | >>= fun dst -> Topkg_care.Pkg.opam pkg 37 | >>= fun opam -> OS.File.read opam 38 | >>= fun opam -> Topkg_care.Pkg.opam_descr pkg 39 | >>= fun descr -> Topkg_care.Pkg.distrib_file dist_pkg 40 | >>= fun distrib_file -> Topkg_care.Pkg.distrib_uri dist_pkg 41 | >>= fun uri -> Topkg_care.Opam.Url.with_distrib_file ~uri distrib_file 42 | >>= fun url -> OS.File.write dst (opam_file_content opam descr url) 43 | >>= fun () -> log_pkg dst; warn_if_vcs_dirty () 44 | >>= fun () -> 45 | Ok 0 46 | 47 | let submit pkg opam_pkg_dst = 48 | Topkg_care.Opam.ensure_publish () 49 | >>= fun () -> get_opam_publish_file pkg opam_pkg_dst 50 | >>= fun opam_file -> OS.File.exists opam_file 51 | >>= function 52 | | false -> 53 | Logs.err (fun m -> m "Package@ file %a@ does@ not@ exist. Did@ you@ \ 54 | forget@ to@ invoke 'topkg opam pkg' ?" 55 | Fpath.pp opam_file); 56 | Ok 1 57 | | true -> 58 | Logs.app (fun m -> m "Publishing %a" Topkg_care.Pp.path opam_file); 59 | Topkg_care.Pkg.publish_msg pkg 60 | >>= fun msg -> Topkg_care.Opam.submit ~opam_file ~msg () 61 | >>= fun () -> Ok 0 62 | 63 | let field pkg field = match field with 64 | | None -> Logs.err (fun m -> m "Missing FIELD positional argument"); Ok 1 65 | | Some field -> 66 | Topkg_care.Pkg.opam_field pkg field 67 | >>= function 68 | | Some v -> Logs.app (fun m -> m "%s" (String.concat ~sep:" " v)); Ok 0 69 | | None -> 70 | Topkg_care.Pkg.opam pkg >>= fun opam -> 71 | Logs.err (fun m -> m "%a: field %s is undefined" Fpath.pp opam field); 72 | Ok 1 73 | 74 | (* Command *) 75 | 76 | let opam () pkg_file build_dir 77 | dist_name dist_version dist_opam dist_uri dist_file 78 | opam_publish_file pkg_name pkg_version pkg_opam pkg_descr 79 | readme change_log publish_msg action field_name 80 | = 81 | let p = 82 | Topkg_care.Pkg.v 83 | ?build_dir ?name:pkg_name ?version:pkg_version ?opam:pkg_opam 84 | ?opam_descr:pkg_descr ?readme ?change_log ?publish_msg pkg_file 85 | in 86 | begin match action with 87 | | `Descr -> descr p 88 | | `Pkg -> 89 | let dist_p = 90 | Topkg_care.Pkg.v 91 | ?build_dir ?name:dist_name ?version:dist_version ?opam:dist_opam 92 | ?distrib_uri:dist_uri ?distrib_file:dist_file ?readme ?change_log 93 | ?publish_msg pkg_file 94 | in 95 | pkg p dist_p opam_publish_file 96 | | `Submit -> submit p opam_publish_file 97 | | `Field -> field p field_name 98 | end 99 | |> Cli.handle_error 100 | 101 | (* Command line interface *) 102 | 103 | open Cmdliner 104 | 105 | let action = 106 | let action = [ "descr", `Descr; "pkg", `Pkg; "submit", `Submit; 107 | "publish", `Submit; "field", `Field ] 108 | in 109 | let doc = strf "The action to perform. $(docv) must be one of %s." 110 | (Arg.doc_alts_enum action) 111 | in 112 | let action = Arg.enum action in 113 | Arg.(required & pos 0 (some action) None & info [] ~doc ~docv:"ACTION") 114 | 115 | let field = 116 | let doc = "the field to output ($(b,field) action)" in 117 | Arg.(value & pos 1 (some string) None & info [] ~doc ~docv:"FIELD") 118 | 119 | let opam_publish_file = 120 | let doc = "The file to use to publish the opam package. If absent the 121 | file $(i,BUILD_DIR)/$(i,PKG_NAME).$(i,PKG_VERSION).opam in the 122 | build directory is used (see options $(b,--build-dir), 123 | $(b,--pkg-name) and $(b,--pkg-version))" 124 | in 125 | let docv = "FILE" in 126 | Arg.(value & opt (some Cli.path_arg) None & info ["opam-publish-file"] 127 | ~doc ~docv) 128 | 129 | let pkg_version = 130 | let doc = "The version string $(docv) of the opam package. If absent provided 131 | provided by the VCS tag description of the HEAD commit." 132 | in 133 | let docv = "PKG_NAME" in 134 | Arg.(value & opt (some string) None & info ["pkg-version"] ~doc ~docv) 135 | 136 | let pkg_opam = 137 | let doc = "The opam file to use for the opam package. If absent uses the 138 | opam file mentioned in the package description that corresponds 139 | to the opam package name $(i,PKG_NAME) (see option 140 | $(b,--pkg-name))" 141 | in 142 | let docv = "FILE" in 143 | Arg.(value & opt (some Cli.path_arg) None & info ["pkg-opam"] ~doc ~docv) 144 | 145 | let pkg_descr = 146 | let doc = "The opam descr file to use for the opam package. If absent 147 | and the opam file has synopsis and description fields this 148 | is used for the description. It absent and there are no such 149 | fields in the opam file and the opam file name 150 | (see $(b,--pkg-opam)) has a `.opam` 151 | extension, uses an existing file with the same path but a `.descr` 152 | extension. If the opam file name is `opam` uses a `descr` 153 | file in the same directory. If these files are not found 154 | a description is extracted from the the readme (see 155 | option $(b,--readme)) as follow: the first marked up 156 | section of the readme is extracted, its title is parsed 157 | according to the pattern '\\$(NAME) \\$(SEP) \\$(SYNOPSIS)', 158 | the body of the section is the long description. A few 159 | lines are filtered out: lines that start with either 160 | 'Home page:', 'Contact:' or '%%VERSION'." 161 | in 162 | let docv = "FILE" in 163 | Arg.(value & opt (some Cli.path_arg) None & info ["pkg-descr"] ~doc ~docv) 164 | 165 | let doc = "Interaction with opam and the OCaml opam repository" 166 | let sdocs = Manpage.s_common_options 167 | let envs = 168 | [ Cmd.Env.info "TOPKG_OPAM_PUBLISH" ~doc:"The $(b,opam-publish) tool to use 169 | to submit packages." ] 170 | 171 | let man_xrefs = [`Main; `Cmd "distrib" ] 172 | let man = 173 | [ `S Manpage.s_synopsis; 174 | `P "$(mname) $(tname) [$(i,OPTION)]... $(i,ACTION)"; 175 | `S Manpage.s_description; 176 | `P "The $(tname) command provides a few actions to interact with 177 | opam and the OCaml opam repository."; 178 | `S "ACTIONS"; 179 | `I ("$(b,descr)", 180 | "extract and print an opam descr file. This is used by the 181 | $(b,pkg) action. See the $(b,--pkg-descr) option for details."); 182 | `I ("$(b,pkg)", 183 | "create an opam package description for a distribution. 184 | The action needs a distribution archive to operate, see 185 | topkg-distrib(1) or the $(b,--dist-file) option."); 186 | `I ("$(b,submit) or $(b,publish)", 187 | "submits a package created with the action $(b,pkg) the OCaml 188 | opam repository. Requires the $(b,opam-publish) tool to be 189 | installed."); 190 | `I ("$(b,field) $(i,FIELD)", 191 | "outputs the field $(i,FIELD) of the package's opam file."); ] 192 | 193 | let cmd = 194 | Cmd.v (Cmd.info "opam" ~doc ~sdocs ~envs ~man ~man_xrefs) @@ 195 | Term.(const opam $ Cli.setup $ Cli.pkg_file $ Cli.build_dir $ 196 | Cli.dist_name $ Cli.dist_version $ Cli.dist_opam $ 197 | Cli.dist_uri $ Cli.dist_file $ 198 | opam_publish_file $ Cli.pkg_name $ pkg_version $ pkg_opam $ 199 | pkg_descr $ Cli.readme $ Cli.change_log $ Cli.publish_msg $ 200 | action $ field) 201 | --------------------------------------------------------------------------------