anil.recoil.org
The unpac monorepo manager self-hosting as a monorepo using unpac
First commit.
+8
.gitignore
+8
.gitignore
+1
.ocp-indent
+1
.ocp-indent
···
1
+
strict_with=always,match_clause=4,strict_else=never
CHANGES.md
CHANGES.md
This is a binary file and will not be displayed.
+43
README.md
+43
README.md
···
1
+
Fmt — OCaml Format pretty-printer combinators
2
+
-------------------------------------------------------------------------------
3
+
Release %%VERSION%%
4
+
5
+
Fmt exposes combinators to devise `Format` pretty-printing functions.
6
+
7
+
Fmt depends only on the OCaml standard library. It is distributed
8
+
under the BSD3 license.
9
+
10
+
Home page: http://erratique.ch/software/fmt
11
+
Contact: Daniel Bünzli `<daniel.buenzl i@erratique.ch>`
12
+
13
+
## Installation
14
+
15
+
Fmt can be installed with `opam`:
16
+
17
+
opam install fmt
18
+
19
+
If you don't use `opam` consult the [`opam`](opam) file for build
20
+
instructions.
21
+
22
+
## Documentation
23
+
24
+
The documentation and API reference is automatically generated by
25
+
`ocamldoc` from the interfaces. It can be consulted [online][5]
26
+
and there is a generated version in the `doc` directory of the
27
+
distribution.
28
+
29
+
[5]: http://erratique.ch/software/fmt/doc/
30
+
31
+
## Sample programs
32
+
33
+
If you installed Fmt with `opam` sample programs are located in
34
+
the directory `opam config var fmt:doc`.
35
+
36
+
In the distribution sample programs are located in the `test`
37
+
directory of the distribution. They can be built with:
38
+
39
+
ocamlbuild -use-ocamlfind test/tests.otarget
40
+
41
+
The resulting binaries are in `_build/test`.
42
+
43
+
- `test.native` tests the library, nothing should fail.
+28
build
+28
build
···
1
+
#!/bin/sh
2
+
# This script is only used for developement. It is removed by the
3
+
# distribution process.
4
+
5
+
set -e
6
+
7
+
OCAMLBUILD=${OCAMLBUILD:="ocamlbuild -tag debug -classic-display \
8
+
-use-ocamlfind" }
9
+
10
+
action ()
11
+
{
12
+
case $1 in
13
+
default) action lib;;
14
+
lib) $OCAMLBUILD fmt.cma fmt.cmxa ;;
15
+
test)
16
+
action lib
17
+
$OCAMLBUILD test/tests.otarget
18
+
;;
19
+
doc) shift; pkg-doc $* doc/dev-api.docdir ;;
20
+
api-doc) shift; pkg-doc $* doc/api.docdir ;;
21
+
clean) $OCAMLBUILD -clean ;;
22
+
*) $OCAMLBUILD $* ;;
23
+
esac
24
+
}
25
+
26
+
if [ $# -eq 0 ];
27
+
then action default ;
28
+
else action $*; fi
+1
doc/api.odocl
+1
doc/api.odocl
···
1
+
Fmt
+1
doc/dev-api.odocl
+1
doc/dev-api.odocl
···
1
+
Fmt
+109
doc/style.css
+109
doc/style.css
···
1
+
/* A style for ocamldoc. Daniel C. Buenzli */
2
+
3
+
/* Reset a few things. */
4
+
html,body,div,span,applet,object,iframe,h1,h2,h3,h4,h5,h6,p,blockquote,pre,
5
+
a,abbr,acronym,address,big,cite,code,del,dfn,em,font,img,ins,kbd,q,s,samp,
6
+
small,strike,strong,sub,sup,tt,var,b,u,i,center,dl,dt,dd,ol,ul,li,fieldset,
7
+
form,label,legend,table,caption,tbody,tfoot,thead,tr,th,td
8
+
{ margin: 0; padding: 0; border: 0 none; outline: 0; font-size: 100%;
9
+
font-weight: inherit; font-style:inherit; font-family:inherit;
10
+
line-height: inherit; vertical-align: baseline; text-align:inherit;
11
+
color:inherit; background: transparent; }
12
+
13
+
table { border-collapse: collapse; border-spacing: 0; }
14
+
15
+
/* Basic page layout */
16
+
17
+
body { font: normal 10pt/1.375em helvetica, arial, sans-serif; text-align:left;
18
+
margin: 1.375em 10%; min-width: 40ex; max-width: 72ex;
19
+
color: black; background: transparent /* url(line-height-22.gif) */; }
20
+
21
+
b { font-weight: bold }
22
+
em { font-style: italic }
23
+
24
+
tt, code, pre { font-family: WorkAroundWebKitAndMozilla, monospace;
25
+
font-size: 1em; }
26
+
pre code { font-size : inherit; }
27
+
.codepre { margin-bottom:1.375em /* after code example we introduce space. */ }
28
+
29
+
.superscript,.subscript
30
+
{ font-size : 0.813em; line-height:0; margin-left:0.4ex;}
31
+
.superscript { vertical-align: super; }
32
+
.subscript { vertical-align: sub; }
33
+
34
+
/* ocamldoc markup workaround hacks */
35
+
36
+
37
+
38
+
hr, hr + br, div + br, center + br, span + br, ul + br, ol + br, pre + br
39
+
{ display: none } /* annoying */
40
+
41
+
div.info + br { display:block}
42
+
43
+
.codepre br + br { display: none }
44
+
h1 + pre { margin-bottom:1.375em} /* Toplevel module description */
45
+
46
+
/* Sections and document divisions */
47
+
48
+
/* .navbar { margin-bottom: -1.375em } */
49
+
h1 { font-weight: bold; font-size: 1.5em; /* margin-top:1.833em; */
50
+
margin-top:0.917em; padding-top:0.875em;
51
+
border-top-style:solid; border-width:1px; border-color:#AAA; }
52
+
h2 { font-weight: bold; font-size: 1.313em; margin-top: 1.048em }
53
+
h3 { font-weight: bold; font-size: 1.125em; margin-top: 1.222em }
54
+
h3 { font-weight: bold; font-size: 1em; margin-top: 1.375em}
55
+
h4 { font-style: italic; }
56
+
57
+
/* Used by OCaml's own library documentation. */
58
+
h6 { font-weight: bold; font-size: 1.125em; margin-top: 1.222em }
59
+
.h7 { font-weight: bold; font-size: 1em; margin-top: 1.375em }
60
+
61
+
p { margin-top: 1.375em }
62
+
pre { margin-top: 1.375em }
63
+
.info { margin: 0.458em 0em -0.458em 2em;}/* Description of types values etc. */
64
+
td .info { margin:0; padding:0; margin-left: 2em;} /* Description in indexes */
65
+
66
+
ul, ol { margin-top:0.688em; padding-bottom:0.687em;
67
+
list-style-position:outside}
68
+
ul + p, ol + p { margin-top: 0em }
69
+
ul { list-style-type: square }
70
+
71
+
72
+
/* h2 + ul, h3 + ul, p + ul { } */
73
+
ul > li { margin-left: 1.375em; }
74
+
ol > li { margin-left: 1.7em; }
75
+
/* Links */
76
+
77
+
a, a:link, a:visited, a:active, a:hover { color : #00B; text-decoration: none }
78
+
a:hover { text-decoration : underline }
79
+
*:target {background-color: #FFFF99;} /* anchor highlight */
80
+
81
+
/* Code */
82
+
83
+
.keyword { font-weight: bold; }
84
+
.comment { color : red }
85
+
.constructor { color : green }
86
+
.string { color : brown }
87
+
.warning { color : red ; font-weight : bold }
88
+
89
+
/* Functors */
90
+
91
+
.paramstable { border-style : hidden ; padding-bottom:1.375em}
92
+
.paramstable code { margin-left: 1ex; margin-right: 1ex }
93
+
.sig_block {margin-left: 1em}
94
+
95
+
/* Images */
96
+
97
+
img { margin-top: 1.375em }
98
+
99
+
100
+
101
+
102
+
103
+
104
+
105
+
106
+
107
+
108
+
109
+
+17
opam
+17
opam
···
1
+
opam-version: "1.2"
2
+
maintainer: "Daniel Bünzli <daniel.buenzl i@erratique.ch>"
3
+
authors: ["Daniel Bünzli <daniel.buenzl i@erratique.ch>"]
4
+
homepage: "http://erratique.ch/software/fmt"
5
+
doc: "http://erratique.ch/software/fmt"
6
+
dev-repo: "http://erratique.ch/repos/fmt.git"
7
+
bug-reports: "https://github.com/dbuenzli/fmt/issues"
8
+
tags: [ "string" "org:erratique" ]
9
+
license: "BSD-3-Clause"
10
+
available: [ ocaml-version >= "4.01.0"]
11
+
depends: [ "ocamlfind" ]
12
+
build:
13
+
[
14
+
[ "ocaml" "pkg/git.ml" ]
15
+
[ "ocaml" "pkg/build.ml" "native=%{ocaml-native}%"
16
+
"native-dynlink=%{ocaml-native-dynlink}%" ]
17
+
]
+8
pkg/META
+8
pkg/META
+10
pkg/build.ml
+10
pkg/build.ml
+11
pkg/config.ml
+11
pkg/config.ml
+13
pkg/git.ml
+13
pkg/git.ml
···
1
+
#!/usr/bin/env ocaml
2
+
#directory "pkg"
3
+
#use "config.ml"
4
+
5
+
(* This is only for git checkout builds, it can be ignored
6
+
for distribution builds. *)
7
+
8
+
let () =
9
+
if Dir.exists ".git" then begin
10
+
Vars.subst ~skip:Config.subst_skip ~vars:Config.vars ~dir:"."
11
+
>>& fun () -> Cmd.exec_hook Config.git_hook
12
+
>>& fun () -> ()
13
+
end
+272
pkg/topkg-ext.ml
+272
pkg/topkg-ext.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2014 Daniel C. Bünzli. All rights reserved.
3
+
Distributed under the BSD3 license, see license at the end of the file.
4
+
%%NAME%% release %%VERSION%%
5
+
---------------------------------------------------------------------------*)
6
+
7
+
let ( >>= ) v f = match v with `Ok v -> f v | `Error _ as e -> e
8
+
let ( >>& ) v f = match v with
9
+
| `Ok v -> f v | `Error e -> Printf.eprintf "%s: %s\n%!" Sys.argv.(0) e; exit 1
10
+
11
+
type 'a result = [ `Ok of 'a | `Error of string ]
12
+
13
+
(** Working with files *)
14
+
module File : sig
15
+
val exists : string -> bool
16
+
(** [exists file] is [true] if [file] exists. *)
17
+
18
+
val read : string -> string result
19
+
(** [read file] is [file]'s contents. *)
20
+
21
+
val write : string -> string -> unit result
22
+
(** [write file content] writes [contents] to [file]. *)
23
+
24
+
val write_subst : string -> (string * string) list -> string -> unit result
25
+
(** [write_subst file vars content] writes [contents] to [file]
26
+
substituting variables of the form [%%ID%%] by their definition.
27
+
The [ID]'s are [List.map fst vars] and their definition content
28
+
is found with [List.assoc]. *)
29
+
30
+
val delete : ?maybe:bool -> string -> unit result
31
+
(** [delete maybe file] deletes file [file]. If [maybe] is [true] (defaults
32
+
to false) no error is reported if the file doesn't exist. *)
33
+
34
+
val temp : unit -> string result
35
+
(** [temp ()] creates a temporary file and returns its name. The file
36
+
is destroyed at the end of program execution. *)
37
+
end = struct
38
+
let exists = Sys.file_exists
39
+
let read file = try
40
+
let ic = open_in file in
41
+
let len = in_channel_length ic in
42
+
let s = String.create len in
43
+
really_input ic s 0 len; close_in ic; `Ok s
44
+
with Sys_error e -> `Error e
45
+
46
+
let write f s = try
47
+
let oc = open_out f in
48
+
output_string oc s; close_out oc; `Ok ()
49
+
with Sys_error e -> `Error e
50
+
51
+
let write_subst f vars s = try
52
+
let oc = open_out f in
53
+
let start = ref 0 in
54
+
let last = ref 0 in
55
+
let len = String.length s in
56
+
while (!last < len - 4) do
57
+
if not (s.[!last] = '%' && s.[!last + 1] = '%') then incr last else
58
+
begin
59
+
let start_subst = !last in
60
+
let last_id = ref (!last + 2) in
61
+
let stop = ref false in
62
+
while (!last_id < len - 1 && not !stop) do
63
+
if not (s.[!last_id] = '%' && s.[!last_id + 1] = '%') then begin
64
+
if s.[!last_id] <> ' ' then (incr last_id) else
65
+
(stop := true; last := !last_id)
66
+
end else begin
67
+
let id_start = start_subst + 2 in
68
+
let id = String.sub s (id_start) (!last_id - id_start) in
69
+
try
70
+
let subst = List.assoc id vars in
71
+
output oc s !start (start_subst - !start);
72
+
output_string oc subst;
73
+
stop := true;
74
+
start := !last_id + 2;
75
+
last := !last_id + 2;
76
+
with Not_found ->
77
+
stop := true;
78
+
last := !last_id
79
+
end
80
+
done
81
+
end
82
+
done;
83
+
output oc s !start (len - !start); close_out oc; `Ok ()
84
+
with Sys_error e -> `Error e
85
+
86
+
let delete ?(maybe = false) file = try
87
+
if maybe && not (exists file) then `Ok () else
88
+
`Ok (Sys.remove file)
89
+
with Sys_error e -> `Error e
90
+
91
+
let temp () = try
92
+
let f = Filename.temp_file (Filename.basename Sys.argv.(0)) "topkg" in
93
+
at_exit (fun () -> ignore (delete f)); `Ok f
94
+
with Sys_error e -> `Error e
95
+
end
96
+
97
+
(** Working with directories. *)
98
+
module Dir : sig
99
+
val exists : string -> bool
100
+
(** [exists dir] is [true] if directory [dir] exists. *)
101
+
102
+
val change_cwd : string -> unit result
103
+
(** [change_cwd dir] changes the current working directory to [dir]. *)
104
+
105
+
val fold_files_rec : ?skip:string list -> (string -> 'a -> 'a result) ->
106
+
'a -> string list -> 'a result
107
+
(** [fold_files_rec skip f acc paths] folds [f] over the files
108
+
found in [paths]. Files and directories whose suffix matches an
109
+
element of [skip] are skipped. *)
110
+
end = struct
111
+
let exists dir = Sys.file_exists dir && Sys.is_directory dir
112
+
let change_cwd dir = try `Ok (Sys.chdir dir) with Sys_error e -> `Error e
113
+
let fold_files_rec ?(skip = []) f acc paths =
114
+
let is_dir d = try Sys.is_directory d with Sys_error _ -> false in
115
+
let readdir d = try Array.to_list (Sys.readdir d) with Sys_error _ -> [] in
116
+
let keep p = not (List.exists (fun s -> Filename.check_suffix p s) skip) in
117
+
let process acc file = match acc with
118
+
| `Error _ as e -> e
119
+
| `Ok acc -> f file acc
120
+
in
121
+
let rec aux f acc = function
122
+
| (d :: ds) :: up ->
123
+
let paths = List.rev_map (Filename.concat d) (readdir d) in
124
+
let paths = List.find_all keep paths in
125
+
let dirs, files = List.partition is_dir paths in
126
+
begin match List.fold_left process acc files with
127
+
| `Error _ as e -> e
128
+
| `Ok _ as acc -> aux f acc (dirs :: ds :: up)
129
+
end
130
+
| [] :: [] -> acc
131
+
| [] :: up -> aux f acc up
132
+
| _ -> assert false
133
+
in
134
+
let paths = List.find_all keep paths in
135
+
let dirs, files = List.partition is_dir paths in
136
+
let acc = List.fold_left process (`Ok acc) files in
137
+
aux f acc (dirs :: [])
138
+
end
139
+
140
+
(** Command invocation. *)
141
+
module Cmd : sig
142
+
val exec : string -> unit result
143
+
(** [exec cmd] executes [cmd]. *)
144
+
145
+
val exec_hook : string option -> unit result
146
+
(** [exec_hook args] is [exec ("ocaml " ^ "args")] if [args] is some. *)
147
+
148
+
val read : string -> string result
149
+
(** [read cmd] executes [cmd] and returns the contents of its stdout. *)
150
+
end = struct
151
+
let exec cmd =
152
+
let code = Sys.command cmd in
153
+
if code = 0 then `Ok () else
154
+
`Error (Printf.sprintf "invocation `%s' exited with %d" cmd code)
155
+
156
+
let exec_hook args = match args with
157
+
| None -> `Ok ()
158
+
| Some args -> exec (Printf.sprintf "ocaml %s" args)
159
+
160
+
let read cmd =
161
+
File.temp () >>= fun file ->
162
+
exec (Printf.sprintf "%s > %s" cmd file) >>= fun () ->
163
+
File.read file >>= fun v ->
164
+
`Ok v
165
+
end
166
+
167
+
(** Variable substitution. *)
168
+
module Vars : sig
169
+
val subst : skip:string list -> vars:(string * string) list ->
170
+
dir:string -> unit result
171
+
(** [subst skip vars dir] substitutes [vars] in all files
172
+
in [dir] except those that are [skip]ped (see {!Dir.fold_files_rec}). *)
173
+
174
+
val get : string -> (string * string) list -> string result
175
+
(** [get v] lookup variable [v] in [vars]. Returns an error if [v] is
176
+
absent or if it is the empty string. *)
177
+
178
+
end = struct
179
+
let subst ~skip ~vars ~dir =
180
+
let subst f () =
181
+
File.read f >>= fun contents ->
182
+
File.write_subst f vars contents >>= fun () -> `Ok ()
183
+
in
184
+
Dir.fold_files_rec ~skip subst () [dir]
185
+
186
+
let get v vars =
187
+
let v = try List.assoc v vars with Not_found -> "" in
188
+
if v <> "" then `Ok v else
189
+
`Error (Printf.sprintf "empty or undefined variable %s in Config.vars" v)
190
+
end
191
+
192
+
(** Git invocations. *)
193
+
module Git : sig
194
+
val describe : ?chop_v:bool -> string -> string
195
+
(** [describe chop_v branch] invokes [git describe branch]. If [chop_v]
196
+
is [true] (defaults to [false]) an initial ['v'] in the result
197
+
is chopped. *)
198
+
end = struct
199
+
let describe ?(chop_v = false) branch =
200
+
if not (Dir.exists ".git") then "not-a-git-checkout" else
201
+
Cmd.read (Printf.sprintf "git describe %s" branch) >>& fun d ->
202
+
let len = String.length d in
203
+
if chop_v && len > 0 && d.[0] = 'v' then String.sub d 1 (len - 2) else
204
+
String.sub d 0 (len - 1) (* remove \n *)
205
+
end
206
+
207
+
(** Default configuration. *)
208
+
module Config_default : sig
209
+
val subst_skip : string list
210
+
(** [subst_skip] is a list of suffixes that are automatically
211
+
skipped during variable substitution. *)
212
+
213
+
val vars : (string * string) list
214
+
(** [vars] is the list of variables to substitute, empty. *)
215
+
216
+
val git_hook : string option
217
+
(** [git_start_hook] is an ocaml script to invoke before a git package
218
+
build, after variable substitution occured. *)
219
+
220
+
val distrib_remove : string list
221
+
(** [distrib_remove] is a list of files to remove before making
222
+
the distributino tarball. *)
223
+
224
+
val distrib_hook : string option
225
+
(** [distrib_hook] is an ocaml script to invoke before trying
226
+
to build the distribution. *)
227
+
228
+
val www_demos : string list
229
+
(** [www_demos] is a list of build targets that represent single page
230
+
js_of_ocaml demo. *)
231
+
end = struct
232
+
let subst_skip = [".git"; ".png"; ".jpeg"; ".otf"; ".ttf"; ".pdf" ]
233
+
let vars = []
234
+
let git_hook = None
235
+
let distrib_remove = [".git"; ".gitignore"; "build"]
236
+
let distrib_hook = None
237
+
let www_demos = []
238
+
end
239
+
240
+
241
+
(*---------------------------------------------------------------------------
242
+
Copyright (c) 2014 Daniel C. Bünzli.
243
+
All rights reserved.
244
+
245
+
Redistribution and use in source and binary forms, with or without
246
+
modification, are permitted provided that the following conditions
247
+
are met:
248
+
249
+
1. Redistributions of source code must retain the above copyright
250
+
notice, this list of conditions and the following disclaimer.
251
+
252
+
2. Redistributions in binary form must reproduce the above
253
+
copyright notice, this list of conditions and the following
254
+
disclaimer in the documentation and/or other materials provided
255
+
with the distribution.
256
+
257
+
3. Neither the name of Daniel C. Bünzli nor the names of
258
+
contributors may be used to endorse or promote products derived
259
+
from this software without specific prior written permission.
260
+
261
+
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
262
+
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
263
+
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
264
+
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
265
+
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
266
+
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
267
+
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
268
+
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
269
+
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
270
+
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
271
+
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
272
+
---------------------------------------------------------------------------*)
+316
pkg/topkg.ml
+316
pkg/topkg.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2014 Daniel C. Bünzli. All rights reserved.
3
+
Distributed under the BSD3 license, see license at the end of the file.
4
+
%%NAME%% release %%VERSION%%
5
+
---------------------------------------------------------------------------*)
6
+
7
+
(* Public api *)
8
+
9
+
(** Build environment access *)
10
+
module type Env = sig
11
+
val bool : string -> bool
12
+
(** [bool key] declares [key] as being a boolean key in the environment.
13
+
Specifing key=(true|false) on the command line becomes mandatory. *)
14
+
15
+
val native : bool
16
+
(** [native] is [bool "native"]. *)
17
+
18
+
val native_dynlink : bool
19
+
(** [native_dylink] is [bool "native-dynlink"] *)
20
+
end
21
+
22
+
(** Exts defines sets of file extensions. *)
23
+
module type Exts = sig
24
+
val interface : string list
25
+
(** [interface] is [[".mli"; ".cmi"; ".cmti"]] *)
26
+
27
+
val interface_opt : string list
28
+
(** [interface_opt] is [".cmx" :: interface] *)
29
+
30
+
val c_library : string list
31
+
(** [c_library] is the extension for C libraries, [".a"] for unices
32
+
and [".lib"] for win32 *)
33
+
34
+
val c_dll_library : string list
35
+
(** [c_dll_library] is the extension for C dynamic libraries [".so"]
36
+
for unices and [".dll"] for win32 *)
37
+
38
+
val library : string list
39
+
(** [library] is [[".cma"; ".cmxa"; ".cmxs"] @ c_library] *)
40
+
41
+
val module_library : string list
42
+
(** [module_library] is [(interface_opt @ library)]. *)
43
+
end
44
+
45
+
(** Package description. *)
46
+
module type Pkg = sig
47
+
type builder = [ `OCamlbuild | `Other of string * string ]
48
+
(** The type for build tools. Either [`OCamlbuild] or an
49
+
[`Other (tool, bdir)] tool [tool] that generates its build artefacts
50
+
in [bdir]. *)
51
+
52
+
type moves
53
+
(** The type for install moves. *)
54
+
55
+
type field = ?cond:bool -> ?exts:string list -> ?dst:string -> string -> moves
56
+
(** The type for field install functions. A call
57
+
[field cond exts dst path] generates install moves as follows:
58
+
{ul
59
+
{- If [cond] is [false] (defaults to [true]), no move is generated.}
60
+
{- If [exts] is present, generates a move for each path in
61
+
the list [List.map (fun e -> path ^ e) exts].}
62
+
{- If [dst] is present this path is used as the move destination
63
+
(allows to install in subdirectories). If absent [dst] is
64
+
[Filename.basename path].} *)
65
+
66
+
val lib : field
67
+
val bin : ?auto:bool -> field
68
+
(** If [auto] is true (defaults to false) generates
69
+
[path ^ ".native"] if {!Env.native} is [true] and
70
+
[path ^ ".byte"] if {!Env.native} is [false]. *)
71
+
val sbin : ?auto:bool -> field (** See {!bin}. *)
72
+
val libexec : ?auto:bool -> field (** See {!bin}. *)
73
+
val toplevel : field
74
+
val share : field
75
+
val share_root : field
76
+
val etc : field
77
+
val doc : field
78
+
val misc : field
79
+
val stublibs : field
80
+
val man : field
81
+
val describe : string -> builder:builder -> moves list -> unit
82
+
(** [describe name builder moves] describes a package named [name] with
83
+
builder [builder] and install moves [moves]. *)
84
+
end
85
+
86
+
(* Implementation *)
87
+
88
+
module Topkg : sig
89
+
val cmd : [`Build | `Explain | `Help ]
90
+
val env : (string * bool) list
91
+
val err_parse : string -> 'a
92
+
val err_mdef : string -> 'a
93
+
val err_miss : string -> 'a
94
+
val err_file : string -> string -> 'a
95
+
val warn_unused : string -> unit
96
+
end = struct
97
+
98
+
(* Parses the command line. The actual cmd execution occurs in the call
99
+
to Pkg.describe. *)
100
+
101
+
let err fmt =
102
+
let k _ = exit 1 in
103
+
Format.kfprintf k Format.err_formatter ("%s: " ^^ fmt ^^ "@.") Sys.argv.(0)
104
+
105
+
let err_parse a = err "argument `%s' is not of the form key=(true|false)" a
106
+
let err_mdef a = err "bool `%s' is defined more than once" a
107
+
let err_miss a = err "argument `%s=(true|false)' is missing" a
108
+
let err_file f e = err "%s: %s" f e
109
+
let warn_unused k =
110
+
Format.eprintf "%s: warning: environment key `%s` unused.@." Sys.argv.(0) k
111
+
112
+
let cmd, env =
113
+
let rec parse_env acc = function (* not t.r. *)
114
+
| arg :: args ->
115
+
begin try
116
+
(* String.cut ... *)
117
+
let len = String.length arg in
118
+
let eq = String.index arg '=' in
119
+
let bool = bool_of_string (String.sub arg (eq + 1) (len - eq - 1)) in
120
+
let key = String.sub arg 0 eq in
121
+
if key = "" then raise Exit else
122
+
try ignore (List.assoc key acc); err_mdef key with
123
+
| Not_found -> parse_env ((key, bool) :: acc) args
124
+
with
125
+
| Invalid_argument _ | Not_found | Exit -> err_parse arg
126
+
end
127
+
| [] -> acc
128
+
in
129
+
match List.tl (Array.to_list Sys.argv) with
130
+
| "explain" :: args -> `Explain, parse_env [] args
131
+
| ("help" | "-h" | "--help" | "-help") :: args -> `Help, parse_env [] args
132
+
| args -> `Build, parse_env [] args
133
+
end
134
+
135
+
module Env : sig
136
+
include Env
137
+
val get : unit -> (string * bool) list
138
+
end = struct
139
+
let env = ref []
140
+
let get () = !env
141
+
let add_bool key b = env := (key, b) :: !env
142
+
let bool key =
143
+
let b = try List.assoc key Topkg.env with
144
+
| Not_found -> if Topkg.cmd = `Build then Topkg.err_miss key else true
145
+
in
146
+
add_bool key b; b
147
+
148
+
let native = bool "native"
149
+
let native_dynlink = bool "native-dynlink"
150
+
end
151
+
152
+
module Exts : Exts = struct
153
+
let interface = [".mli"; ".cmi"; ".cmti"]
154
+
let interface_opt = ".cmx" :: interface
155
+
let c_library = if Sys.win32 then [".lib"] else [".a"]
156
+
let c_dll_library = if Sys.win32 then [".dll"] else [".so"]
157
+
let library = [".cma"; ".cmxa"; ".cmxs"] @ c_library
158
+
let module_library = (interface_opt @ library)
159
+
end
160
+
161
+
module Pkg : Pkg = struct
162
+
type builder = [ `OCamlbuild | `Other of string * string ]
163
+
type moves = (string * (string * string)) list
164
+
type field = ?cond:bool -> ?exts:string list -> ?dst:string -> string -> moves
165
+
166
+
let str = Printf.sprintf
167
+
let warn_unused () =
168
+
let keys = List.map fst Topkg.env in
169
+
let keys_used = List.map fst (Env.get ()) in
170
+
let unused = List.find_all (fun k -> not (List.mem k keys_used)) keys in
171
+
List.iter Topkg.warn_unused unused
172
+
173
+
let has_suffix = Filename.check_suffix
174
+
let build_strings ?(exec_sep = " ") btool bdir mvs =
175
+
let no_build = [ ".cmti"; ".cmt" ] in
176
+
let install = Buffer.create 1871 in
177
+
let exec = Buffer.create 1871 in
178
+
let rec add_mvs current = function
179
+
| (field, (src, dst)) :: mvs when field = current ->
180
+
if List.exists (has_suffix src) no_build then
181
+
Buffer.add_string install (str "\n \"?%s/%s\" {\"%s\"}" bdir src dst)
182
+
else begin
183
+
Buffer.add_string exec (str "%s%s" exec_sep src);
184
+
Buffer.add_string install (str "\n \"%s/%s\" {\"%s\"}" bdir src dst);
185
+
end;
186
+
add_mvs current mvs
187
+
| (((field, _) :: _) as mvs) ->
188
+
if current <> "" (* first *) then Buffer.add_string install " ]\n";
189
+
Buffer.add_string install (str "%s: [" field);
190
+
add_mvs field mvs
191
+
| [] -> ()
192
+
in
193
+
Buffer.add_string exec btool;
194
+
add_mvs "" mvs;
195
+
Buffer.add_string install " ]\n";
196
+
Buffer.contents install, Buffer.contents exec
197
+
198
+
let pr = Format.printf
199
+
let pr_explanation btool bdir pkg mvs =
200
+
let env = Env.get () in
201
+
let install, exec = build_strings ~exec_sep:" \\\n " btool bdir mvs in
202
+
pr "@[<v>";
203
+
pr "Package name: %s@," pkg;
204
+
pr "Build tool: %s@," btool;
205
+
pr "Build directory: %s@," bdir;
206
+
pr "Environment:@, ";
207
+
List.iter (fun (k,v) -> pr "%s=%b@, " k v) (List.sort compare env);
208
+
pr "@,Build invocation:@,";
209
+
pr " %s@,@," exec;
210
+
pr "Install file:@,";
211
+
pr "%s@," install;
212
+
pr "@]";
213
+
()
214
+
215
+
let pr_help () =
216
+
pr "Usage example:@\n %s" Sys.argv.(0);
217
+
List.iter (fun (k,v) -> pr " %s=%b" k v) (List.sort compare (Env.get ()));
218
+
pr "@."
219
+
220
+
let build btool bdir pkg mvs =
221
+
let install, exec = build_strings btool bdir mvs in
222
+
let e = Sys.command exec in
223
+
if e <> 0 then exit e else
224
+
let install_file = pkg ^ ".install" in
225
+
try
226
+
let oc = open_out install_file in
227
+
output_string oc install; flush oc; close_out oc
228
+
with Sys_error e -> Topkg.err_file install_file e
229
+
230
+
let mvs ?(drop_exts = []) field ?(cond = true) ?(exts = []) ?dst src =
231
+
if not cond then [] else
232
+
let mv src dst = (field, (src, dst)) in
233
+
let expand exts s d = List.map (fun e -> mv (s ^ e) (d ^ e)) exts in
234
+
let dst = match dst with None -> Filename.basename src | Some dst -> dst in
235
+
let files = if exts = [] then [mv src dst] else expand exts src dst in
236
+
let keep (_, (src, _)) = not (List.exists (has_suffix src) drop_exts) in
237
+
List.find_all keep files
238
+
239
+
let lib =
240
+
let drop_exts =
241
+
if Env.native && not Env.native_dynlink then [ ".cmxs" ] else
242
+
if not Env.native then Exts.c_library @ [".cmx"; ".cmxa"; ".cmxs" ]
243
+
else []
244
+
in
245
+
mvs ~drop_exts "lib"
246
+
247
+
let share = mvs "share"
248
+
let share_root = mvs "share_root"
249
+
let etc = mvs "etc"
250
+
let toplevel = mvs "toplevel"
251
+
let doc = mvs "doc"
252
+
let misc = mvs "misc"
253
+
let stublibs = mvs "stublibs"
254
+
let man = mvs "man"
255
+
256
+
let bin_drops = if not Env.native then [ ".native" ] else []
257
+
let bin_mvs field ?(auto = false) ?cond ?exts ?dst src =
258
+
let src, dst =
259
+
if not auto then src, dst else
260
+
let dst = match dst with
261
+
| None -> Some (Filename.basename src)
262
+
| Some _ as dst -> dst
263
+
in
264
+
let src = if Env.native then src ^ ".native" else src ^ ".byte" in
265
+
src, dst
266
+
in
267
+
mvs ~drop_exts:bin_drops field ?cond ?dst src
268
+
269
+
let bin = bin_mvs "bin"
270
+
let sbin = bin_mvs "sbin"
271
+
let libexec = bin_mvs "libexec"
272
+
273
+
let describe pkg ~builder mvs =
274
+
let mvs = List.sort compare (List.flatten mvs) in
275
+
let btool, bdir = match builder with
276
+
| `OCamlbuild -> "ocamlbuild -use-ocamlfind -classic-display", "_build"
277
+
| `Other (btool, bdir) -> btool, bdir
278
+
in
279
+
match Topkg.cmd with
280
+
| `Explain -> pr_explanation btool bdir pkg mvs
281
+
| `Help -> pr_help ()
282
+
| `Build -> warn_unused (); build btool bdir pkg mvs
283
+
end
284
+
285
+
(*---------------------------------------------------------------------------
286
+
Copyright (c) 2014 Daniel C. Bünzli.
287
+
All rights reserved.
288
+
289
+
Redistribution and use in source and binary forms, with or without
290
+
modification, are permitted provided that the following conditions
291
+
are met:
292
+
293
+
1. Redistributions of source code must retain the above copyright
294
+
notice, this list of conditions and the following disclaimer.
295
+
296
+
2. Redistributions in binary form must reproduce the above
297
+
copyright notice, this list of conditions and the following
298
+
disclaimer in the documentation and/or other materials provided
299
+
with the distribution.
300
+
301
+
3. Neither the name of Daniel C. Bünzli nor the names of
302
+
contributors may be used to endorse or promote products derived
303
+
from this software without specific prior written permission.
304
+
305
+
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
306
+
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
307
+
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
308
+
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
309
+
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
310
+
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
311
+
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
312
+
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
313
+
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
314
+
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
315
+
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
316
+
---------------------------------------------------------------------------*)
+212
src/fmt.ml
+212
src/fmt.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright 2014 Daniel C. Bünzli. All rights reserved.
3
+
Distributed under the BSD3 license, see license at the end of the file.
4
+
%%NAME%% release %%VERSION%%
5
+
---------------------------------------------------------------------------*)
6
+
7
+
(* Formatters *)
8
+
9
+
type 'a t = Format.formatter -> 'a -> unit
10
+
11
+
let pp ppf fmt = Format.fprintf ppf fmt
12
+
let kpp ppf fmt = Format.kfprintf ppf fmt
13
+
let rpp fmt ppf = Format.fprintf ppf fmt
14
+
15
+
let nop fmt ppf = ()
16
+
let cut = Format.pp_print_cut
17
+
let sp = Format.pp_print_space
18
+
let const pp_v v ppf () = pp ppf "%a" pp_v v
19
+
20
+
(* OCaml base type formatters *)
21
+
22
+
let bool = Format.pp_print_bool
23
+
let int = Format.pp_print_int
24
+
let int32 ppf v = pp ppf "%ld" v
25
+
let int64 ppf v = pp ppf "%Ld" v
26
+
let uint32 ppf v = pp ppf "%lu" v
27
+
let uint64 ppf v = pp ppf "%Lu" v
28
+
let uint ppf v = pp ppf "%u" v
29
+
30
+
let string = Format.pp_print_string
31
+
let const_string s ppf () = pp ppf "%s" s
32
+
33
+
(* Floats *)
34
+
35
+
let float ppf v = pp ppf "%g" v
36
+
37
+
let round x = floor (x +. 0.5)
38
+
let round_dfrac d x =
39
+
if x -. (round x) = 0. then x else (* x is an integer. *)
40
+
let m = 10. ** (float_of_int d) in (* m moves 10^-d to 1. *)
41
+
(floor ((x *. m) +. 0.5)) /. m
42
+
43
+
let round_dsig d x =
44
+
if x = 0. then 0. else
45
+
let m = 10. ** (floor (log10 (abs_float x))) in (* to normalize x. *)
46
+
(round_dfrac d (x /. m)) *. m
47
+
48
+
let float_dfrac d ppf f = pp ppf "%g" (round_dfrac d f)
49
+
let float_dsig d ppf f = pp ppf "%g" (round_dsig d f)
50
+
51
+
(* OCaml container formatters *)
52
+
53
+
let none ppf () = pp ppf "None"
54
+
let some pp_v ppf v = pp ppf "@[<1>Some@ %a@]" pp_v v
55
+
let option ?(pp_none = fun ppf () -> ()) pp_v ppf = function
56
+
| None -> pp_none ppf ()
57
+
| Some v -> pp_v ppf v
58
+
59
+
let rec list ?(pp_sep = cut) pp_v ppf = function
60
+
| [] -> ()
61
+
| v :: vs ->
62
+
pp_v ppf v; if vs <> [] then (pp_sep ppf (); list ~pp_sep pp_v ppf vs)
63
+
64
+
(* Brackets *)
65
+
66
+
let parens pp_v ppf v = pp ppf "@[<1>(%a)@]" pp_v v
67
+
let brackets pp_v ppf v = pp ppf "@[<1>[%a]@]" pp_v v
68
+
let braces pp_v ppf v = pp ppf "@[<1>{%a}@]" pp_v v
69
+
70
+
(* Text and lines *)
71
+
72
+
let white_str ~spaces ppf s =
73
+
let left = ref 0 and right = ref 0 and len = String.length s in
74
+
let flush () =
75
+
Format.pp_print_string ppf (String.sub s !left (!right - !left));
76
+
incr right; left := !right;
77
+
in
78
+
while (!right <> len) do
79
+
if s.[!right] = '\n' then (flush (); Format.pp_force_newline ppf ()) else
80
+
if spaces && s.[!right] = ' ' then (flush (); Format.pp_print_space ppf ())
81
+
else incr right;
82
+
done;
83
+
if !left <> len then flush ()
84
+
85
+
let text = white_str ~spaces:true
86
+
let lines = white_str ~spaces:false
87
+
let text_range ppf ((l0, c0), (l1, c1)) = pp ppf "%d.%d-%d.%d" l0 c0 l1 c1
88
+
89
+
let doomed ppf reason =
90
+
pp ppf "Something@ unreasonable@ is@ going@ on (%a).@ You@ are@ doomed."
91
+
text reason
92
+
93
+
(* Byte sizes *)
94
+
95
+
let _pp_byte_size k i ppf s =
96
+
let pp_frac = float_dfrac 1 in
97
+
let div_round_up m n = (m + n - 1) / n in
98
+
let float = float_of_int in
99
+
if s < k then pp ppf "%dB" s else
100
+
let m = k * k in
101
+
if s < m then begin
102
+
let kstr = if i = "" then "k" (* SI *) else "K" (* IEC *) in
103
+
let sk = s / k in
104
+
if sk < 10
105
+
then pp ppf "%a%s%sB" pp_frac (float s /. float k) kstr i
106
+
else pp ppf "%d%s%sB" (div_round_up s k) kstr i
107
+
end else
108
+
let g = k * m in
109
+
if s < g then begin
110
+
let sm = s / m in
111
+
if sm < 10
112
+
then pp ppf "%aM%sB" pp_frac (float s /. float m) i
113
+
else pp ppf "%dM%sB" (div_round_up s m) i
114
+
end else
115
+
let t = k * g in
116
+
if s < t then begin
117
+
let sg = s / g in
118
+
if sg < 10
119
+
then pp ppf "%aG%sB" pp_frac (float s /. float g) i
120
+
else pp ppf "%dG%sB" (div_round_up s g) i
121
+
end else
122
+
let p = k * t in
123
+
if s < p then begin
124
+
let st = s / t in
125
+
if st < 10
126
+
then pp ppf "%aT%sB" pp_frac (float s /. float t) i
127
+
else pp ppf "%dT%sB" (div_round_up s t) i
128
+
end else begin
129
+
let sp = s / p in
130
+
if sp < 10
131
+
then pp ppf "%aP%sB" pp_frac (float s /. float p) i
132
+
else pp ppf "%dP%sB" (div_round_up s p) i
133
+
end
134
+
135
+
let byte_size ppf s = _pp_byte_size 1000 "" ppf s
136
+
let bi_byte_size ppf s = _pp_byte_size 1024 "i" ppf s
137
+
138
+
(* Conditional UTF-8 formatting *)
139
+
140
+
let utf_8_enabled, set_utf_8_enabled =
141
+
let enabled = ref false in
142
+
(fun () -> !enabled), (fun b -> enabled := b)
143
+
144
+
let if_utf_8 pp_u pp ppf v = (if utf_8_enabled () then pp_u else pp) ppf v
145
+
146
+
(* Styled formatting *)
147
+
148
+
type style_tags = [ `Ansi | `None ]
149
+
type style =
150
+
[ `Bold | `Underline | `Black | `Red | `Green | `Yellow | `Blue | `Magenta
151
+
| `Cyan | `White | `None ]
152
+
153
+
let (style_tags : unit -> style_tags), (set_style_tags : style_tags -> unit) =
154
+
let style_tags = ref `None in
155
+
(fun () -> !style_tags), (fun s -> style_tags := s)
156
+
157
+
let ansi_style_code = function
158
+
| `Bold -> "\027[01m"
159
+
| `Underline -> "\027[04m"
160
+
| `Black -> "\027[30m"
161
+
| `Red -> "\027[31m"
162
+
| `Green -> "\027[32m"
163
+
| `Yellow -> "\027[33m"
164
+
| `Blue -> "\027[1;34m"
165
+
| `Magenta -> "\027[35m"
166
+
| `Cyan -> "\027[36m"
167
+
| `White -> "\027[37m"
168
+
| `None -> "\027[m"
169
+
170
+
let ansi_style_reset = "\027[m"
171
+
172
+
let styled style pp_v ppf = match style_tags () with
173
+
| `None -> pp_v ppf
174
+
| `Ansi ->
175
+
Format.kfprintf
176
+
(fun ppf -> pp ppf "@<0>%s" ansi_style_reset) ppf "@<0>%s%a"
177
+
(ansi_style_code style) pp_v
178
+
179
+
let styled_string style = styled style string
180
+
181
+
(*---------------------------------------------------------------------------
182
+
Copyright 2014 Daniel C. Bünzli.
183
+
All rights reserved.
184
+
185
+
Redistribution and use in source and binary forms, with or without
186
+
modification, are permitted provided that the following conditions
187
+
are met:
188
+
189
+
1. Redistributions of source code must retain the above copyright
190
+
notice, this list of conditions and the following disclaimer.
191
+
192
+
2. Redistributions in binary form must reproduce the above
193
+
copyright notice, this list of conditions and the following
194
+
disclaimer in the documentation and/or other materials provided
195
+
with the distribution.
196
+
197
+
3. Neither the name of Daniel C. Bünzli nor the names of
198
+
contributors may be used to endorse or promote products derived
199
+
from this software without specific prior written permission.
200
+
201
+
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
202
+
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
203
+
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
204
+
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
205
+
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
206
+
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
207
+
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
208
+
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
209
+
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
210
+
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
211
+
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
212
+
---------------------------------------------------------------------------*)
+235
src/fmt.mli
+235
src/fmt.mli
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2014 Daniel C. Bünzli. All rights reserved.
3
+
Distributed under the BSD3 license, see license at the end of the file.
4
+
%%NAME%% release %%VERSION%%
5
+
---------------------------------------------------------------------------*)
6
+
7
+
(** {!Format} pretty-printer combinators. *)
8
+
9
+
(** {1 Formatters} *)
10
+
11
+
type 'a t = Format.formatter -> 'a -> unit
12
+
(** The type for formatters of values of type ['a]. *)
13
+
14
+
val pp : Format.formatter ->
15
+
('a, Format.formatter, unit) Pervasives.format -> 'a
16
+
(** [pp] is {!Format.fprintf}. *)
17
+
18
+
val kpp : (Format.formatter -> 'a) -> Format.formatter ->
19
+
('b, Format.formatter, unit, 'a) format4 -> 'b
20
+
(** [kpp] is {!Format.kfprintf}. *)
21
+
22
+
val rpp : ('a, Format.formatter, unit) Pervasives.format ->
23
+
Format.formatter -> 'a
24
+
(** [rpp] is [pp fmt ppf] *)
25
+
26
+
val nop : 'a t
27
+
(** [nop] formats nothing. *)
28
+
29
+
val cut : unit t
30
+
(** [cut] is {!Format.pp_print_cut}. *)
31
+
32
+
val sp : unit t
33
+
(** [sp] is {!Format.pp_print_space}. *)
34
+
35
+
val const : 'a t -> 'a -> unit t
36
+
(** [const pp_v v] always formats [v] using [pp_v]. *)
37
+
38
+
val doomed : string t
39
+
(** [doomed] should be used for printing a message when reasonable
40
+
assumptions are being violated. The string should be a short
41
+
description of what is going on. *)
42
+
43
+
(** {1:basetypes OCaml base type formatters} *)
44
+
45
+
val bool : bool t
46
+
(** [bool] is {!Format.pp_print_bool}. *)
47
+
48
+
val int : int t
49
+
(** [int] is {!Format.pp_print_int}. *)
50
+
51
+
val int32 : int32 t
52
+
(** [int32 ppf] is [pp ppf "%ld"]. *)
53
+
54
+
val int64 : int64 t
55
+
(** [int64 ppf] is [pp ppf "%Ld"]. *)
56
+
57
+
val uint32 : int32 t
58
+
(** [int32 ppf] is [pp ppf "%lu"]. *)
59
+
60
+
val uint64 : int64 t
61
+
(** [uint64 ppf] is [pp ppf "%Lu"]. *)
62
+
63
+
val uint : int t
64
+
(** [uint ppf] is [pp ppf "%u"]. *)
65
+
66
+
val float : float t
67
+
(** [float ppf] is [pp ppf "%g".] *)
68
+
69
+
val float_dfrac : int -> float t
70
+
(** [float_dfrac d] rounds the float to the [d]th {e decimal}
71
+
fractional digit and formats the result with ["%g"]. Ties are
72
+
rounded towards positive infinity. The result is only defined
73
+
for [0 <= d <= 16]. *)
74
+
75
+
val float_dsig : int -> float t
76
+
(** [pp_float_dsig d] rounds the normalized {e decimal} significand
77
+
of the float to the [d]th decimal fractional digit and formats
78
+
the result with ["%g"]. Ties are rounded towards positive
79
+
infinity. The result is NaN on infinities and only defined for
80
+
[0 <= d <= 16].
81
+
82
+
{b Warning.} The current implementation overflows on large [d]
83
+
and floats. *)
84
+
85
+
val string : string t
86
+
(** [string] is {!Format.pp_print_string}. *)
87
+
88
+
val const_string : string -> unit t
89
+
(** [const_string s] is [const string s]. *)
90
+
91
+
(** {1:conts OCaml container formatters} *)
92
+
93
+
val none : unit t
94
+
(** [none ppf] is [pp ppf "None"]. *)
95
+
96
+
val some : 'a t -> 'a t
97
+
(** [some pp_v ppf] is [pp ppf "@[<1>Some@ %a@]" pp_v]. *)
98
+
99
+
val option : ?pp_none:unit t -> 'a t -> 'a option t
100
+
(** [option pp_none pp_v] formats value of type ['a option] using
101
+
[pp_v] and [pp_none] defaults to {!nop}. *)
102
+
103
+
val list : ?pp_sep:unit t -> 'a t -> 'a list t
104
+
(** [pp_list pp_sep pp_v] formats lists of type ['a]. Each value is
105
+
printed with [pp_v], and values are separated by [pp_sep]
106
+
(defaults to {!cut}). {!nop} on empty lists. *)
107
+
108
+
(** {1:bracks Brackets} *)
109
+
110
+
val parens : 'a t -> 'a t
111
+
(** [parens pp_v ppf] is [pp "@[<1>(%a)@]" pp_v]. *)
112
+
113
+
val brackets : 'a t -> 'a t
114
+
(** [brackets pp_v ppf] is [pp "@[<1>[%a]@]" pp_v]. *)
115
+
116
+
val braces : 'a t -> 'a t
117
+
(** [brackets pp_v ppf] is [pp "@[<1>{%a}@]" pp_v]. *)
118
+
119
+
(** {1:text Text and lines} *)
120
+
121
+
val text : string t
122
+
(** [pp_text] formats text by replacing spaces and newlines in the string
123
+
with calls to {!Format.pp_print_space} and {!Format.pp_force_newline}. *)
124
+
125
+
val lines : string t
126
+
(** [pp_lines] formats lines by replacing newlines in the string
127
+
with calls to {!Format.pp_force_newline}. *)
128
+
129
+
val text_range : ((int * int) * (int * int)) t
130
+
(** [text_range] formats a line-column text range according to
131
+
{{:http://www.gnu.org/prep/standards/standards.html#Errors}
132
+
GNU conventions}. *)
133
+
134
+
(** {1 Byte sizes} *)
135
+
136
+
val byte_size : int t
137
+
(** [pp_byte_size] formats a byte size according to its magnitude
138
+
using {{:http://www.bipm.org/en/publications/si-brochure/chapter3.html}
139
+
SI prefixes} up to peta bytes (10{^15}). *)
140
+
141
+
val bi_byte_size : int t
142
+
(** [pp_bi_byte_size] formats a byte size according to its magnitude
143
+
using {{:https://en.wikipedia.org/wiki/Binary_prefix}binary prefixes}
144
+
up to pebi bytes (2{^15}). *)
145
+
146
+
(** {1:utf8_cond Conditional UTF-8 formatting}
147
+
148
+
{b Note.} Since {!Format} is not UTF-8 aware using UTF-8 output
149
+
may derail the pretty printing process. Use the pretty-printers
150
+
from {!Uuseg_string} if you are serious about UTF-8 formatting. *)
151
+
152
+
val if_utf_8 : 'a t -> 'a t -> 'a t
153
+
(** [if_utf_8 pp_u pp] is a t that will use [pp_u] if UTF-8
154
+
output is {{!utf_8_enabled}enabled} and [pp] otherwise. *)
155
+
156
+
(** {2:utf8_cond Conditional UTF-8 formatting control} *)
157
+
158
+
val utf_8_enabled : unit -> bool
159
+
(** [utf_8_enabled ()] is [true] if UTF-8 pretty-printing is enabled. *)
160
+
161
+
val set_utf_8_enabled : bool -> unit
162
+
(** [set_utf_8_enabled b] sets UTF-8 pretty-printing to [b]. *)
163
+
164
+
(** {1:styled Styled formatting} *)
165
+
166
+
type style =
167
+
[ `Bold
168
+
| `Underline
169
+
| `Black
170
+
| `Red
171
+
| `Green
172
+
| `Yellow
173
+
| `Blue
174
+
| `Magenta
175
+
| `Cyan
176
+
| `White
177
+
| `None ]
178
+
(** The type for styles. *)
179
+
180
+
val styled : style -> 'a t -> 'a t
181
+
(** [styled style pp] formats according to [pp] but styled with [style]. *)
182
+
183
+
val styled_string : style -> string t
184
+
(** [styled_string style] is [pp_styled style string]. *)
185
+
186
+
(** {2 Styled formatting control} *)
187
+
188
+
type style_tags = [ `Ansi | `None ]
189
+
(** The type for style tags.
190
+
{ul
191
+
{- [`Ansi], tags the text with
192
+
{{:http://www.ecma-international.org/publications/standards/Ecma-048.htm}
193
+
ANSI escape sequences}.}
194
+
{- [`None], text remains untagged.}} *)
195
+
196
+
val style_tags : unit -> style_tags
197
+
(** [style_tags ()] is the current tag style used by {!Fmt.pp_styled}.
198
+
Initial value is [`None]. *)
199
+
200
+
val set_style_tags : style_tags -> unit
201
+
(** [set_style_tags s] sets the current tag style used by
202
+
{!Fmt.pp_styled}. *)
203
+
204
+
(*---------------------------------------------------------------------------
205
+
Copyright (c) 2014 Daniel C. Bünzli.
206
+
All rights reserved.
207
+
208
+
Redistribution and use in source and binary forms, with or without
209
+
modification, are permitted provided that the following conditions
210
+
are met:
211
+
212
+
1. Redistributions of source code must retain the above copyright
213
+
notice, this list of conditions and the following disclaimer.
214
+
215
+
2. Redistributions in binary form must reproduce the above
216
+
copyright notice, this list of conditions and the following
217
+
disclaimer in the documentation and/or other materials provided
218
+
with the distribution.
219
+
220
+
3. Neither the name of Daniel C. Bünzli nor the names of
221
+
contributors may be used to endorse or promote products derived
222
+
from this software without specific prior written permission.
223
+
224
+
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
225
+
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
226
+
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
227
+
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
228
+
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
229
+
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
230
+
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
231
+
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
232
+
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
233
+
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
234
+
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
235
+
---------------------------------------------------------------------------*)
+1
src/fmt.mllib
+1
src/fmt.mllib
···
1
+
Fmt
test/tests.itarget
test/tests.itarget
This is a binary file and will not be displayed.