The unpac monorepo manager self-hosting as a monorepo using unpac
Merge opam/patches/swhid_core
+1193
+40
vendor/opam/swhid_core/.github/workflows/build.yml
+40
vendor/opam/swhid_core/.github/workflows/build.yml
···
1
+
name: build
2
+
on:
3
+
pull_request:
4
+
branches:
5
+
- main
6
+
push:
7
+
branches:
8
+
- main
9
+
jobs:
10
+
build:
11
+
strategy:
12
+
fail-fast: false
13
+
matrix:
14
+
os:
15
+
- macos-latest
16
+
- ubuntu-latest
17
+
- windows-latest
18
+
ocaml-compiler:
19
+
- 4.14.0
20
+
include:
21
+
- os: ubuntu-latest
22
+
ocaml-compiler: 4.03.0
23
+
runs-on: ${{ matrix.os }}
24
+
steps:
25
+
- name: checkout
26
+
uses: actions/checkout@v2
27
+
- name: setup-ocaml
28
+
uses: avsm/setup-ocaml@v2
29
+
with:
30
+
ocaml-compiler: ${{ matrix.ocaml-compiler }}
31
+
- name: setup
32
+
run: |
33
+
opam pin add . -y --no-action
34
+
opam depext -y swhid_core
35
+
opam install -y ./*.opam --deps-only --with-test
36
+
opam upgrade --fixup
37
+
- name: build
38
+
run: opam exec -- dune build @install
39
+
- name: test
40
+
run: opam exec -- dune runtest
+36
vendor/opam/swhid_core/.github/workflows/deploy.yml
+36
vendor/opam/swhid_core/.github/workflows/deploy.yml
···
1
+
name: deploy
2
+
on:
3
+
push:
4
+
branches:
5
+
- main
6
+
jobs:
7
+
deploy:
8
+
runs-on: ubuntu-latest
9
+
steps:
10
+
- name: checkout
11
+
uses: actions/checkout@v2
12
+
with:
13
+
submodules: recursive
14
+
persist-credentials: false
15
+
- name: setup-ocaml
16
+
uses: avsm/setup-ocaml@v2
17
+
with:
18
+
ocaml-compiler: 4.12.0
19
+
- name: setup-deploy
20
+
run: |
21
+
opam pin add . -y --no-action
22
+
opam depext -y swhid_core
23
+
opam install -y ./*.opam --deps-only --with-test --with-doc
24
+
opam upgrade --fixup
25
+
touch doc/.nojekyll
26
+
- name: api
27
+
run: |
28
+
opam exec -- dune build @doc
29
+
mv _build/default/_doc/_html/ doc/api
30
+
- name: deploy
31
+
uses: JamesIves/github-pages-deploy-action@3.6.2
32
+
with:
33
+
GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
34
+
BRANCH: gh-pages
35
+
FOLDER: doc/
36
+
CLEAN: true
+1
vendor/opam/swhid_core/.gitignore
+1
vendor/opam/swhid_core/.gitignore
···
1
+
_build
+42
vendor/opam/swhid_core/.ocamlformat
+42
vendor/opam/swhid_core/.ocamlformat
···
1
+
version=0.21.0
2
+
assignment-operator=end-line
3
+
break-cases=fit
4
+
break-fun-decl=wrap
5
+
break-fun-sig=wrap
6
+
break-infix=wrap
7
+
break-infix-before-func=false
8
+
break-separators=before
9
+
break-sequences=true
10
+
cases-exp-indent=2
11
+
cases-matching-exp-indent=normal
12
+
doc-comments=before
13
+
doc-comments-padding=2
14
+
doc-comments-tag-only=default
15
+
dock-collection-brackets=false
16
+
exp-grouping=preserve
17
+
field-space=loose
18
+
if-then-else=compact
19
+
indicate-multiline-delimiters=space
20
+
indicate-nested-or-patterns=unsafe-no
21
+
infix-precedence=indent
22
+
leading-nested-match-parens=false
23
+
let-and=sparse
24
+
let-binding-spacing=compact
25
+
let-module=compact
26
+
margin=80
27
+
max-indent=68
28
+
module-item-spacing=sparse
29
+
ocp-indent-compat=false
30
+
parens-ite=false
31
+
parens-tuple=always
32
+
parse-docstrings=true
33
+
sequence-blank-line=preserve-one
34
+
sequence-style=terminator
35
+
single-case=compact
36
+
space-around-arrays=true
37
+
space-around-lists=true
38
+
space-around-records=true
39
+
space-around-variants=true
40
+
type-decl=sparse
41
+
wrap-comments=false
42
+
wrap-fun-args=true
+8
vendor/opam/swhid_core/LICENSE.md
+8
vendor/opam/swhid_core/LICENSE.md
···
1
+
The ISC License (ISC)
2
+
=====================
3
+
4
+
Copyright © 2022, OCamlPro <contact@ocamlpro.com>
5
+
6
+
Permission to use, copy, modify, and/or distribute this software for any purpose with or without fee is hereby granted, provided that the above copyright notice and this permission notice appear in all copies.
7
+
8
+
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+39
vendor/opam/swhid_core/README.md
+39
vendor/opam/swhid_core/README.md
···
1
+
# swhid_core
2
+
3
+
[swhid_core] is an [OCaml] library to work with [persistent identifiers] used by [Software Heritage], also known as swhid. This is the core library, for most use cases you should use the [swhid library] instead.
4
+
5
+
## Installation
6
+
7
+
`swhid_core` can be installed with [opam]:
8
+
9
+
```sh
10
+
opam install swhid_core
11
+
```
12
+
13
+
If you don't have `opam`, you can install it following the [how to install opam] guide.
14
+
15
+
If you can't or don't want to use `opam`, consult the [opam file] for build instructions.
16
+
17
+
## Quickstart
18
+
19
+
Have a look at the [example] folder or at the [documentation].
20
+
21
+
## About
22
+
23
+
- [LICENSE]
24
+
- [CHANGELOG]
25
+
26
+
[CHANGELOG]: ./CHANGES.md
27
+
[example]: ./example
28
+
[LICENSE]: ./LICENSE.md
29
+
[opam file]: ./swhid_core.opam
30
+
[test suite]: ./test
31
+
32
+
[documentation]: https://ocamlpro.github.io/swhid_core/api/swhid_core/
33
+
[how to install opam]: https://opam.ocaml.org/doc/Install.html
34
+
[OCaml]: https://ocaml.org
35
+
[opam]: https://opam.ocaml.org/
36
+
[persistent identifiers]: https://docs.softwareheritage.org/devel/swh-model/persistent-identifiers.html
37
+
[Software Heritage]: https://www.softwareheritage.org
38
+
[swhid library]: https://github.com/OCamlPro/swhid
39
+
[swhid_core]: https://github.com/OCamlPro/swhid_core
+3
vendor/opam/swhid_core/doc/dune
+3
vendor/opam/swhid_core/doc/dune
vendor/opam/swhid_core/doc/favicon.png
vendor/opam/swhid_core/doc/favicon.png
This is a binary file and will not be displayed.
+38
vendor/opam/swhid_core/doc/index.html
+38
vendor/opam/swhid_core/doc/index.html
···
1
+
<!DOCTYPE html>
2
+
<html lang="en">
3
+
<head>
4
+
<meta charset="utf-8">
5
+
<title>swhid_core</title>
6
+
<link rel="stylesheet" href="style.css">
7
+
<link rel="icon" type="image/png" sizes="804x804" href="favicon.png">
8
+
</head>
9
+
<body>
10
+
<div class="content">
11
+
<div class="header">
12
+
<h1>swhid_core</h1>
13
+
14
+
<p>swhid_core is an <a href="https://ocaml.org">OCaml</a> library to work with <a href="https://docs.softwareheritage.org/devel/swh-model/persistent-identifiers.html">persistent identifiers</a> found in <a href="https://www.softwareheritage.org">Software Heritage identifiers</a>, also known as swhid.</p>
15
+
</div>
16
+
17
+
<div class="section">
18
+
<ul>
19
+
<li>
20
+
<a href="https://github.com/OCamlPro/swhid_core">Project on Github</a>
21
+
</li>
22
+
23
+
<li>
24
+
<a href="api/swhid_core/">API Documentation</a>
25
+
</li>
26
+
27
+
<li>
28
+
<a href="coverage">Code coverage report</a>
29
+
</li>
30
+
31
+
<li>
32
+
<a href="https://github.com/OCamlPro/swhid_core/issues">Bug reports</a>
33
+
</li>
34
+
</ul>
35
+
</div>
36
+
</div>
37
+
</body>
38
+
</html>
+9
vendor/opam/swhid_core/doc/index.mld
+9
vendor/opam/swhid_core/doc/index.mld
+18
vendor/opam/swhid_core/doc/style.css
+18
vendor/opam/swhid_core/doc/style.css
···
1
+
body {
2
+
color: #444;
3
+
background-color: #EEEEEE;
4
+
line-height:1.6;
5
+
font-size:18px;
6
+
}
7
+
.content {
8
+
width: 80%;
9
+
margin-left: 100px;
10
+
margin-top: 100px;
11
+
font-family: sans-serif;
12
+
}
13
+
a:link{
14
+
color:#5bf
15
+
}
16
+
a:visited{
17
+
color:#55f
18
+
}
+41
vendor/opam/swhid_core/dune-project
+41
vendor/opam/swhid_core/dune-project
···
1
+
(lang dune 1.11)
2
+
3
+
(explicit_js_mode)
4
+
5
+
(implicit_transitive_deps false)
6
+
7
+
(name swhid_core)
8
+
9
+
(license ISC)
10
+
11
+
(authors
12
+
"Léo Andrès <contact@ndrs.fr>" "Dario Pinto <dario.pinto@ocamlpro.com>")
13
+
14
+
(maintainers "Léo Andrès <contact@ndrs.fr>")
15
+
16
+
(source
17
+
(github ocamlpro/swhid_core))
18
+
19
+
(generate_opam_files true)
20
+
21
+
(package
22
+
(name swhid_core)
23
+
(synopsis "OCaml library to work with swhids")
24
+
(description
25
+
"swhid_core is an OCaml library to with with Software Heritage persistent identifiers (swhids). This is the core library, for most use cases you should use the swhid library instead.")
26
+
(tags
27
+
(swhid_core
28
+
swhid
29
+
swh
30
+
persistent
31
+
identifiers
32
+
hash
33
+
software
34
+
heritage
35
+
archive))
36
+
(depends
37
+
(ocaml
38
+
(>= 4.03))
39
+
(dune
40
+
(>= 1.11))
41
+
(odoc :with-doc)))
+4
vendor/opam/swhid_core/example/dune
+4
vendor/opam/swhid_core/example/dune
+10
vendor/opam/swhid_core/example/main.ml
+10
vendor/opam/swhid_core/example/main.ml
+295
vendor/opam/swhid_core/src/compute.ml
+295
vendor/opam/swhid_core/src/compute.ml
···
1
+
(* TODO: remove once we get >= 4.08 *)
2
+
let result_is_error = function Ok _v -> false | Error _v -> true
3
+
let result_get_ok = function Ok v -> v | Error _v -> invalid_arg "Result.get_ok"
4
+
5
+
type directory_entry_kind =
6
+
| File
7
+
| Dir
8
+
9
+
module Make (SHA1 : sig
10
+
val digest_string_to_hex : string -> string
11
+
end) (OS : sig
12
+
val contents : string -> string list option
13
+
14
+
val typ : string -> directory_entry_kind option
15
+
16
+
val read_file : string -> string option
17
+
18
+
val permissions : string -> int option
19
+
20
+
val base : string -> string
21
+
end) =
22
+
struct
23
+
module Git = struct
24
+
let target_kind_to_git = function
25
+
| Object.Kind.Content _hash_type -> "blob"
26
+
| Directory -> "tree"
27
+
| Release -> "tag"
28
+
| Revision -> "commit"
29
+
| Snapshot -> "refs"
30
+
31
+
let id_to_bytes id =
32
+
String.init
33
+
(String.length id / 2)
34
+
(fun i ->
35
+
let s = String.sub id (2 * i) 2 in
36
+
Char.chr @@ int_of_string @@ "0x" ^ s )
37
+
38
+
let object_to_swhid (obj : string) object_type =
39
+
let scheme = Object.Scheme_version.default in
40
+
let hash = SHA1.digest_string_to_hex obj in
41
+
match Object.Hash.of_string hash with
42
+
| Error _msg as e -> e
43
+
| Ok hash ->
44
+
let core_identifier =
45
+
Object.Core_identifier.mk scheme object_type hash
46
+
in
47
+
Ok (Object.mk core_identifier [])
48
+
49
+
let object_header fmt (git_type, len) =
50
+
match git_type with
51
+
| "blob" | "commit" | "extid" | "raw_extrinsic_metadata" | "snapshot"
52
+
| "tag" | "tree" ->
53
+
Format.fprintf fmt "%s %d\x00" git_type len
54
+
| git_type ->
55
+
invalid_arg
56
+
(Format.sprintf "invalid git object type `%s` (Git.object_header)"
57
+
git_type )
58
+
59
+
let object_from_contents_strtarget target_kind contents =
60
+
let len = String.length contents in
61
+
Format.asprintf "%a%s" object_header (target_kind, len) contents
62
+
63
+
let object_from_contents target_kind contents =
64
+
object_from_contents_strtarget (target_kind_to_git target_kind) contents
65
+
66
+
(* TODO: remove once we have > 4.03 *)
67
+
let string_split_on_char sep s =
68
+
let r = ref [] in
69
+
let j = ref (String.length s) in
70
+
for i = String.length s - 1 downto 0 do
71
+
if String.unsafe_get s i = sep then begin
72
+
r := String.sub s (i + 1) (!j - i - 1) :: !r;
73
+
j := i
74
+
end
75
+
done;
76
+
String.sub s 0 !j :: !r
77
+
78
+
let escape_newlines snippet =
79
+
String.concat "\n " (string_split_on_char '\n' snippet)
80
+
81
+
(* TODO: replace with Int.abs when we have >= 4.08 *)
82
+
let abs x = if x >= 0 then x else -x
83
+
84
+
let format_offset fmt (offset, negative_utc) =
85
+
let sign =
86
+
if offset < 0 || (offset = 0 && negative_utc) then "-" else "+"
87
+
in
88
+
let offset = abs offset in
89
+
let hours = offset / 60 in
90
+
let minutes = offset mod 60 in
91
+
Format.fprintf fmt "%s%02d%02d" sign hours minutes
92
+
93
+
let format_author_data fmt (author, date) =
94
+
Format.fprintf fmt "%s" author;
95
+
match date with
96
+
| None -> ()
97
+
| Some (timestamp, tz_offset, negative_utc) ->
98
+
Format.fprintf fmt " %Ld %a" timestamp format_offset
99
+
(tz_offset, negative_utc)
100
+
end
101
+
102
+
type directory_entry =
103
+
{ typ : directory_entry_kind
104
+
; permissions : int
105
+
; name : string
106
+
; target : Object.Core_identifier.t
107
+
}
108
+
109
+
type date =
110
+
{ timestamp : Int64.t
111
+
; tz_offset : int
112
+
; negative_utc : bool
113
+
}
114
+
115
+
let content_identifier content =
116
+
let typ = Object.Kind.Content "sha1_git" in
117
+
let git_object = Git.object_from_contents typ content in
118
+
Git.object_to_swhid git_object typ
119
+
120
+
let directory_identifier entries =
121
+
let entries =
122
+
List.sort
123
+
(fun entry1 entry2 ->
124
+
String.compare
125
+
(if entry1.typ = Dir then entry1.name ^ "/" else entry1.name)
126
+
(if entry2.typ = Dir then entry2.name ^ "/" else entry2.name) )
127
+
entries
128
+
in
129
+
let content =
130
+
Format.asprintf "%a"
131
+
(Format.pp_print_list
132
+
~pp_sep:(fun _fmt () -> ())
133
+
(fun fmt entry ->
134
+
Format.fprintf fmt "%o %s%c%s" entry.permissions entry.name '\x00'
135
+
(Git.id_to_bytes
136
+
( Object.Hash.to_string
137
+
@@ Object.Core_identifier.get_hash entry.target ) ) ) )
138
+
entries
139
+
in
140
+
let typ = Object.Kind.Directory in
141
+
let git_object = Git.object_from_contents typ content in
142
+
Git.object_to_swhid git_object typ
143
+
144
+
(* TODO: remove once we have >= 4.05 *)
145
+
let rec list_find_opt p = function
146
+
| [] -> None
147
+
| x :: l -> if p x then Some x else list_find_opt p l
148
+
149
+
let rec directory_identifier_deep name =
150
+
match OS.contents name with
151
+
| None -> Error (Format.sprintf "can't get contents of `%s`" name)
152
+
| Some contents -> (
153
+
let entries =
154
+
List.map
155
+
(fun name ->
156
+
let typ = OS.typ name in
157
+
let target =
158
+
match typ with
159
+
| Some File -> begin
160
+
match OS.read_file name with
161
+
| None -> Error (Format.sprintf "can't read file `%s`" name)
162
+
| Some content -> content_identifier content
163
+
end
164
+
| Some Dir -> directory_identifier_deep name
165
+
| None ->
166
+
Error (Format.sprintf "can't get type of file `%s`" name)
167
+
in
168
+
let permissions = OS.permissions name in
169
+
match (typ, permissions, target) with
170
+
| Some typ, Some permissions, Ok target ->
171
+
let name = OS.base name in
172
+
let target = Object.get_core target in
173
+
Ok { typ; permissions; target; name }
174
+
| _ -> Error "can't compute directory deep identifier" )
175
+
contents
176
+
in
177
+
match list_find_opt result_is_error entries with
178
+
| Some (Error _ as e) -> e
179
+
| Some _ -> assert false
180
+
| None -> directory_identifier (List.map result_get_ok entries) )
181
+
182
+
(* TODO: remove once we have >= 4.08 *)
183
+
let option_map f = function None -> None | Some v -> Some (f v)
184
+
185
+
let release_identifier target target_kind ~name ~author date ~message =
186
+
let buff = Buffer.create 512 in
187
+
let fmt = Format.formatter_of_buffer buff in
188
+
189
+
Format.fprintf fmt "object %a%ctype %s%ctag %s%c" Object.Hash.pp target '\n'
190
+
(Git.target_kind_to_git target_kind)
191
+
'\n' (Git.escape_newlines name) '\n';
192
+
193
+
begin
194
+
match author with
195
+
| None -> ()
196
+
| Some author ->
197
+
Format.fprintf fmt "tagger %a%c" Git.format_author_data
198
+
( Git.escape_newlines author
199
+
, option_map
200
+
(fun o -> (o.timestamp, o.tz_offset, o.negative_utc))
201
+
date )
202
+
'\n'
203
+
end;
204
+
205
+
begin
206
+
match message with
207
+
| None -> ()
208
+
| Some message -> Format.fprintf fmt "%c%s" '\n' message
209
+
end;
210
+
211
+
Format.pp_print_flush fmt ();
212
+
213
+
let content = Buffer.contents buff in
214
+
215
+
let typ = Object.Kind.Release in
216
+
let git_object = Git.object_from_contents typ content in
217
+
Git.object_to_swhid git_object typ
218
+
219
+
let revision_identifier directory parents ~author ~author_date ~committer
220
+
~committer_date extra_headers ~message =
221
+
let buff = Buffer.create 512 in
222
+
let fmt = Format.formatter_of_buffer buff in
223
+
224
+
Format.fprintf fmt "tree %a%c" Object.Hash.pp directory '\n';
225
+
226
+
List.iter
227
+
(fun parent -> Format.fprintf fmt "parent %a%c" Object.Hash.pp parent '\n')
228
+
parents;
229
+
230
+
Format.fprintf fmt "author %a%c" Git.format_author_data
231
+
( Git.escape_newlines author
232
+
, option_map
233
+
(fun o -> (o.timestamp, o.tz_offset, o.negative_utc))
234
+
author_date )
235
+
'\n';
236
+
237
+
Format.fprintf fmt "committer %a%c" Git.format_author_data
238
+
( Git.escape_newlines committer
239
+
, option_map
240
+
(fun o -> (o.timestamp, o.tz_offset, o.negative_utc))
241
+
committer_date )
242
+
'\n';
243
+
244
+
Array.iter
245
+
(fun (k, v) -> Format.fprintf fmt "%s %s%c" k (Git.escape_newlines v) '\n')
246
+
extra_headers;
247
+
248
+
begin
249
+
match message with
250
+
| None -> ()
251
+
| Some message -> Format.fprintf fmt "%c%s" '\n' message
252
+
end;
253
+
254
+
Format.pp_print_flush fmt ();
255
+
256
+
let content = Buffer.contents buff in
257
+
258
+
let typ = Object.Kind.Revision in
259
+
let git_object = Git.object_from_contents typ content in
260
+
Git.object_to_swhid git_object typ
261
+
262
+
let snapshot_identifier (branches : (string * (string * string) option) list)
263
+
=
264
+
let branches =
265
+
List.sort
266
+
(fun (name1, _target) (name2, _target) -> String.compare name1 name2)
267
+
branches
268
+
in
269
+
let buff = Buffer.create 512 in
270
+
let fmt = Format.formatter_of_buffer buff in
271
+
List.iter
272
+
(fun (branch_name, target) ->
273
+
let target, target_kind, target_id_len =
274
+
match target with
275
+
| None -> ("", "dangling", 0)
276
+
| Some (target, target_kind) -> (
277
+
match target_kind with
278
+
| "content" | "directory" | "revision" | "release" | "snapshot" ->
279
+
(Git.id_to_bytes target, target_kind, 20)
280
+
| "alias" -> (target, "alias", String.length target)
281
+
| target_kind ->
282
+
invalid_arg
283
+
(Format.sprintf
284
+
"invalid target type: `%s` (Compute.snapshot_identifier)"
285
+
target_kind ) )
286
+
in
287
+
Format.fprintf fmt "%s %s%c%d:%s" target_kind branch_name '\x00'
288
+
target_id_len target )
289
+
branches;
290
+
Format.pp_print_flush fmt ();
291
+
let content = Buffer.contents buff in
292
+
293
+
let git_object = Git.object_from_contents_strtarget "snapshot" content in
294
+
Git.object_to_swhid git_object Object.Kind.Snapshot
295
+
end
+123
vendor/opam/swhid_core/src/compute.mli
+123
vendor/opam/swhid_core/src/compute.mli
···
1
+
(** Module to compute a swhid for all kinds of objects. *)
2
+
3
+
(** The type of directory entries. *)
4
+
type directory_entry_kind =
5
+
| File
6
+
| Dir
7
+
8
+
module Make (SHA1 : sig
9
+
(** A module containing the needed hash functions. *)
10
+
11
+
(** [digest_string_to_hex s] computes the SHA1 hash of [s] and returns its
12
+
hexadecimal representation. *)
13
+
val digest_string_to_hex : string -> string
14
+
end) (OS : sig
15
+
(** A module containing the needed OS-related functions. *)
16
+
17
+
(** [contents dir] returns the list of files in the directory [dir]. *)
18
+
val contents : string -> string list option
19
+
20
+
(** [type file] returns [Dir] if [file] is a directory and [File] otherwise. *)
21
+
val typ : string -> directory_entry_kind option
22
+
23
+
(** [read_file f] returns the content of the file [f]. *)
24
+
val read_file : string -> string option
25
+
26
+
(** [permissions f] returns the 16-bit file mode (as stored by Git) of the
27
+
file [f]. That is:
28
+
29
+
- [0o120000] if [f] is a symlink
30
+
- [0o040000] if [f] is a directory
31
+
- [0o100755] if [f] is an executable file
32
+
- [0o100644] if [f] is a regular file *)
33
+
val permissions : string -> int option
34
+
35
+
(** [base f] is the basename of file [f]. *)
36
+
val base : string -> string
37
+
end) : sig
38
+
(** A functor that, given a SHA1 module and a OS module, provides various
39
+
functions to compute the swhid of a given object. Supported objects are
40
+
[content], [directory], [release], [revision] and [snapshot]. The origins
41
+
and visits objects are not supported. *)
42
+
43
+
(** The type for directory entries list, needed to compute directories
44
+
identifiers. *)
45
+
type directory_entry =
46
+
{ typ : directory_entry_kind
47
+
; permissions : int
48
+
; name : string
49
+
; target : Object.Core_identifier.t
50
+
}
51
+
52
+
(** The type for dates, needed to compute releases and revisions identifiers. *)
53
+
type date =
54
+
{ timestamp : Int64.t
55
+
; tz_offset : int
56
+
; negative_utc : bool
57
+
}
58
+
59
+
(** [content_identifier s] computes the swhid for the [s] content. [s] is the
60
+
raw content of a file as a [string].
61
+
62
+
E.g. [content_identifier "_build\n"] is the swhid of this library's
63
+
[.gitignore] file. *)
64
+
val content_identifier : string -> (Object.t, string) result
65
+
66
+
(** [directory_identifier entries] compute the swhid for the [entries]
67
+
directory. [entries] is a list of [Kinds.directory_entry] where each
68
+
element points to another object (usually a file content or a
69
+
sub-directory).
70
+
71
+
E.g.
72
+
[directory_identifier \[ { typ = "file"
73
+
; permissions = 33188
74
+
; name = "README"
75
+
; target = "37ec8ea2110c0b7a32fbb0e872f6e7debbf95e21"
76
+
}\]]
77
+
is the swhid of a directory which has a single file [README] with
78
+
permissions 33188 and whose core identifier from [content_identifier] is
79
+
[37ec8ea2110c0b7a32fbb0e872f6e7debbf95e21]. *)
80
+
val directory_identifier : directory_entry list -> (Object.t, string) result
81
+
82
+
(** [directory_identifier_deep] compute the swhid for a given directory name,
83
+
it uses the various functions provided in the [OS] module parameter to
84
+
list directory contents, get file permissions and read file contents.*)
85
+
val directory_identifier_deep : string -> (Object.t, string) result
86
+
87
+
(** [release_identifier target target_kind name ~author date ~message]
88
+
computes the swhid for a release object pointing to an object of type
89
+
[target_kind] whose identifier is [target], the release having [~name],
90
+
[~author] and has been published on [date] with the release [~message]. *)
91
+
val release_identifier :
92
+
Object.Hash.t
93
+
-> Object.Kind.t
94
+
-> name:string
95
+
-> author:string option
96
+
-> date option
97
+
-> message:string option
98
+
-> (Object.t, string) result
99
+
100
+
(** [revision dir parents ~author ~author_date ~committer ~committer_date extra_headers message]
101
+
computes the swhid for a revision object whose directory has id [dir] and
102
+
whose parents has ids [parents] which was authored by [~author] on
103
+
[~author_date] and committed by [~committer] on [~committer_date] with
104
+
extra headers [extra_headers] and message [message]. *)
105
+
val revision_identifier :
106
+
Object.Hash.t
107
+
-> Object.Hash.t list
108
+
-> author:string
109
+
-> author_date:date option
110
+
-> committer:string
111
+
-> committer_date:date option
112
+
-> (string * string) array
113
+
-> message:string option
114
+
-> (Object.t, string) result
115
+
116
+
(** [snapshot_identifier branches] computes the swhid of the snapshot made of
117
+
branches [branches] where [branches] is a list of branch elements. Each
118
+
branch is of the form [name, target] where [name] is the name of the
119
+
branch and where [target] is a pair made of the identifier of the branch
120
+
and its type. *)
121
+
val snapshot_identifier :
122
+
(string * (string * string) option) list -> (Object.t, string) result
123
+
end
+3
vendor/opam/swhid_core/src/dune
+3
vendor/opam/swhid_core/src/dune
+247
vendor/opam/swhid_core/src/object.ml
+247
vendor/opam/swhid_core/src/object.ml
···
1
+
(* TODO: remove once we have >= 4.08 *)
2
+
let result_is_error = function Ok _v -> false | Error _v -> true
3
+
let result_get_ok = function Ok v -> v | Error _v -> invalid_arg "Result.get_ok"
4
+
5
+
6
+
module Scheme_version = struct
7
+
type t = int
8
+
9
+
let of_string = function
10
+
| "1" -> Ok 1
11
+
| invalid -> Error (Format.sprintf "invalid scheme version `%s`" invalid)
12
+
13
+
let of_int = function
14
+
| 1 -> Ok 1
15
+
| invalid -> Error (Format.sprintf "invalid scheme version `%d`" invalid)
16
+
17
+
let to_int x = x
18
+
19
+
let pp fmt v = Format.fprintf fmt "%d" v
20
+
21
+
let default = 1
22
+
end
23
+
24
+
module Kind = struct
25
+
type t =
26
+
| Content of string
27
+
| Directory
28
+
| Revision
29
+
| Release
30
+
| Snapshot
31
+
32
+
let compare t t' =
33
+
match (t, t') with
34
+
| Directory, Directory
35
+
| Release, Release
36
+
| Revision, Revision
37
+
| Snapshot, Snapshot ->
38
+
0
39
+
| Content c, Content c' -> String.compare c c'
40
+
| Content _, _ -> 1
41
+
| _, Content _ -> -1
42
+
| Directory, _ -> 1
43
+
| _, Directory -> -1
44
+
| Revision, _ -> 1
45
+
| _, Revision -> -1
46
+
| Release, _ -> 1
47
+
| _, Release -> -1
48
+
49
+
let equal t t' = compare t t' = 0
50
+
51
+
let of_string = function
52
+
| "cnt" -> Ok (Content "sha1_git")
53
+
| "dir" -> Ok Directory
54
+
| "rel" -> Ok Release
55
+
| "rev" -> Ok Revision
56
+
| "snp" -> Ok Snapshot
57
+
| invalid -> Error (Format.sprintf "invalid object kind `%s`" invalid)
58
+
59
+
let to_string = function
60
+
| Content _f -> "cnt"
61
+
| Directory -> "dir"
62
+
| Release -> "rel"
63
+
| Revision -> "rev"
64
+
| Snapshot -> "snp"
65
+
66
+
let pp fmt v = Format.fprintf fmt "%s" (to_string v)
67
+
end
68
+
69
+
module Hash = struct
70
+
type t = string
71
+
72
+
let compare = String.compare
73
+
74
+
let equal = String.equal
75
+
76
+
let of_string s =
77
+
let len = ref 0 in
78
+
try
79
+
String.iter
80
+
(function
81
+
| 'a' .. 'f' | '0' .. '9' -> incr len | _invalid_char -> raise Exit )
82
+
s;
83
+
if !len = 40 then Ok s else raise Exit
84
+
with Exit -> Error (Format.sprintf "invalid object hash `%s`" s)
85
+
86
+
let to_string v = v
87
+
88
+
let pp fmt v = Format.fprintf fmt "%s" v
89
+
end
90
+
91
+
(* TODO: remove once we have > 4.03 *)
92
+
let string_split_on_char sep s =
93
+
let r = ref [] in
94
+
let j = ref (String.length s) in
95
+
for i = String.length s - 1 downto 0 do
96
+
if String.unsafe_get s i = sep then begin
97
+
r := String.sub s (i + 1) (!j - i - 1) :: !r;
98
+
j := i
99
+
end
100
+
done;
101
+
String.sub s 0 !j :: !r
102
+
103
+
module Core_identifier = struct
104
+
type t = Scheme_version.t * Kind.t * Hash.t
105
+
106
+
let compare (sch_version, object_type, hash)
107
+
(sch_version', object_type', hash') =
108
+
let scheme_version = sch_version - sch_version' in
109
+
if scheme_version <> 0 then scheme_version
110
+
else
111
+
let object_type = Kind.compare object_type object_type' in
112
+
if object_type <> 0 then object_type else Hash.compare hash hash'
113
+
114
+
let equal t t' = compare t t' = 0
115
+
116
+
let of_string s =
117
+
match string_split_on_char ':' s with
118
+
| [ "swh"; "1"; t; hash ] -> begin
119
+
match Kind.of_string t with
120
+
| Error _msg as e -> e
121
+
| Ok t -> begin
122
+
match Hash.of_string hash with
123
+
| Error _msg as e -> e
124
+
| Ok hash ->
125
+
let scheme = Scheme_version.default in
126
+
Ok (scheme, t, hash)
127
+
end
128
+
end
129
+
| _whatever -> Error "invalid core identifier"
130
+
131
+
let mk scheme typ hash = (scheme, typ, hash)
132
+
133
+
let pp fmt (scheme, typ, hash) =
134
+
Format.fprintf fmt "swh:%a:%a:%a" Scheme_version.pp scheme Kind.pp typ
135
+
Hash.pp hash
136
+
137
+
let to_string v = Format.asprintf "%a" pp v
138
+
139
+
let get_scheme (scheme, _kind, _hash) = scheme
140
+
141
+
let get_kind (_scheme, kind, _hash) = kind
142
+
143
+
let get_hash (_scheme, _kind, hash) = hash
144
+
end
145
+
146
+
module Qualifier = struct
147
+
type t =
148
+
| Anchor of Core_identifier.t
149
+
| Origin of string
150
+
| Path of string
151
+
| Visit of Core_identifier.t
152
+
| Fragment of (int * int option)
153
+
154
+
let int_of_string_opt s = try Some (int_of_string s) with Failure _ -> None
155
+
156
+
let of_string s =
157
+
match string_split_on_char '=' s with
158
+
| "lines" :: lines -> begin
159
+
match string_split_on_char '-' (String.concat "" lines) with
160
+
| [ l1 ] -> begin
161
+
match int_of_string_opt l1 with
162
+
| None -> Error "invalid qualifier"
163
+
| Some i -> Ok (Fragment (i, None))
164
+
end
165
+
| [ l1; l2 ] -> begin
166
+
match (int_of_string_opt l1, int_of_string_opt l2) with
167
+
| Some i1, Some i2 -> Ok (Fragment (i1, Some i2))
168
+
| _, _ -> Error "invalid qualifier"
169
+
end
170
+
| _whatever -> Error "invalid qualifier"
171
+
end
172
+
| "path" :: path ->
173
+
(* TODO: check RFC 3987 IRI compliance *)
174
+
let path = String.concat "" path in
175
+
Ok (Path path)
176
+
| "origin" :: url ->
177
+
(* TODO: check RFC 3987 absolute path compliance *)
178
+
let url = String.concat "" url in
179
+
Ok (Origin url)
180
+
| "visit" :: id -> (
181
+
let id = String.concat "" id in
182
+
match Core_identifier.of_string id with
183
+
| Error _msg as e -> e
184
+
| Ok id -> Ok (Visit id) )
185
+
| "anchor" :: id -> (
186
+
let id = String.concat "" id in
187
+
match Core_identifier.of_string id with
188
+
| Error _msg as e -> e
189
+
| Ok id -> Ok (Anchor id) )
190
+
| _whatever -> Error "invalid qualifier"
191
+
192
+
let pp fmt = function
193
+
| Anchor id -> Format.fprintf fmt "anchor=%a" Core_identifier.pp id
194
+
| Origin uri -> Format.fprintf fmt "origin=%s" uri
195
+
| Path path -> Format.fprintf fmt "path=%s" path
196
+
| Visit id -> Format.fprintf fmt "visit=%a" Core_identifier.pp id
197
+
| Fragment (l1, l2) -> (
198
+
Format.fprintf fmt "lines=%d" l1;
199
+
match l2 with None -> () | Some l2 -> Format.fprintf fmt "-%d" l2 )
200
+
201
+
let to_string q = Format.asprintf "%a" pp q
202
+
end
203
+
204
+
type t = Core_identifier.t * Qualifier.t list
205
+
206
+
(* TODO: remove once we have >= 4.05 *)
207
+
let rec list_find_opt p = function
208
+
| [] -> None
209
+
| x :: l -> if p x then Some x else list_find_opt p l
210
+
211
+
let of_string s =
212
+
match string_split_on_char ';' s with
213
+
| id :: qualifiers -> begin
214
+
match Core_identifier.of_string id with
215
+
| Error _msg as e -> e
216
+
| Ok object_core_identifier -> begin
217
+
let qualifiers = List.map Qualifier.of_string qualifiers in
218
+
match list_find_opt result_is_error qualifiers with
219
+
| Some (Error _msg as e) -> e
220
+
| Some _ -> assert false
221
+
| None ->
222
+
let qualifiers = List.map result_get_ok qualifiers in
223
+
Ok (object_core_identifier, qualifiers)
224
+
end
225
+
end
226
+
| _whatever -> Error "invalid swhid"
227
+
228
+
let mk object_core_identifier qualifiers = (object_core_identifier, qualifiers)
229
+
230
+
let get_core (core, _qualifiers) = core
231
+
232
+
let get_scheme (core, _qualifiers) = Core_identifier.get_scheme core
233
+
234
+
let get_kind (core, _qualifiers) = Core_identifier.get_kind core
235
+
236
+
let get_hash (core, _qualifiers) = Core_identifier.get_hash core
237
+
238
+
let get_qualifiers (_core, qualifiers) = qualifiers
239
+
240
+
let pp_qualifiers fmt q = List.iter (Format.fprintf fmt ";%a" Qualifier.pp) q
241
+
242
+
let pp fmt id =
243
+
let i = get_core id in
244
+
let q = get_qualifiers id in
245
+
Format.fprintf fmt "%a%a" Core_identifier.pp i pp_qualifiers q
246
+
247
+
let to_string id = Format.asprintf "%a" pp id
+187
vendor/opam/swhid_core/src/object.mli
+187
vendor/opam/swhid_core/src/object.mli
···
1
+
(** This module contains the various types used to represent a Software Heritage
2
+
persistent identifier (swhid). These identifiers are documented on
3
+
{{:https://docs.softwareheritage.org/devel/swh-model/persistent-identifiers.html}
4
+
Software Heritage}.
5
+
6
+
In short, a swhid is made of a mandatory core identifier (a scheme version,
7
+
a kind and a hash) and an optional list of qualifiers. *)
8
+
9
+
module Scheme_version : sig
10
+
(** Module to work with the scheme version of a swhid.*)
11
+
12
+
(** The type of scheme versions. *)
13
+
type t
14
+
15
+
(** [of_string s] is [Ok v] if [s] is a valid scheme version, otherwise it is
16
+
[Error e]. *)
17
+
val of_string : string -> (t, string) result
18
+
19
+
(** [of_int n] is [Ok v] if [n] is a valid scheme version, otherwise it is
20
+
[Error e]. *)
21
+
val of_int : int -> (t, string) result
22
+
23
+
(** [to_int v] is the representation of [v] as an integer. *)
24
+
val to_int : t -> int
25
+
26
+
(** [pp fmt v] prints [v] on formatter [fmt]. *)
27
+
val pp : Format.formatter -> t -> unit
28
+
29
+
(** [default] is the default scheme version. *)
30
+
val default : t
31
+
end
32
+
33
+
module Kind : sig
34
+
(** Module to work with the different kinds of software artifacts a swhid can
35
+
points to. They're documented
36
+
{{:https://docs.softwareheritage.org/devel/swh-model/data-model.html#software-artifacts}
37
+
here}. *)
38
+
39
+
(** The type of the different kinds of software artifacts. *)
40
+
type t =
41
+
| Content of string
42
+
(** Contents (AKA "blobs"). the string parameter is the name of the hash
43
+
function used for the computation, defaults to ["sha1_git"] and in
44
+
most use cases you don't care about it. *)
45
+
| Directory (** Directories. *)
46
+
| Revision (** Revisions. *)
47
+
| Release (** Releases. *)
48
+
| Snapshot (** Snapshots. *)
49
+
50
+
(** [compare x y] returns [0] if [x] is equal to [y], a negative integer if
51
+
[x] is less than [y], and a positive integer if [x] is greater than [y]. *)
52
+
val compare : t -> t -> int
53
+
54
+
(** [equal x y] returns [true] iff [x] is equal to [y]. *)
55
+
val equal : t -> t -> bool
56
+
57
+
(** [of_string s] is [Ok v] if [s] is a valid kind of object, otherwise it is
58
+
[Error e]. The valid kinds are ["cnt"], ["dir"], ["rel"], ["rev"] and
59
+
["snp"]. *)
60
+
val of_string : string -> (t, string) result
61
+
62
+
(** [pp fmt v] prints [v] on formatter [fmt]. *)
63
+
val pp : Format.formatter -> t -> unit
64
+
65
+
(** [to_string v] is the representation of [v] as a string. *)
66
+
val to_string : t -> string
67
+
end
68
+
69
+
module Hash : sig
70
+
(** Module to work with the hash component of a swhid. *)
71
+
72
+
(** The type of hashes. *)
73
+
type t
74
+
75
+
(** [compare x y] returns [0] if [x] is equal to [y], a negative integer if
76
+
[x] is less than [y], and a positive integer if [x] is greater than [y]. *)
77
+
val compare : t -> t -> int
78
+
79
+
(** [equal x y] returns [true] iff [x] is equal to [y]. *)
80
+
val equal : t -> t -> bool
81
+
82
+
(** [of_string s] is [Ok v] if [s] is a valid hash, otherwise it is [Error e].
83
+
A hash is valid if it's made of 40 hexadecimal characters. *)
84
+
val of_string : string -> (t, string) result
85
+
86
+
(** [pp fmt v] prints [v] on formatter [fmt]. *)
87
+
val pp : Format.formatter -> t -> unit
88
+
89
+
(** [to_string v] is the representation of [v] as a string. *)
90
+
val to_string : t -> string
91
+
end
92
+
93
+
module Core_identifier : sig
94
+
(** Module to work with the core identifier of a swhid. The core identifier of
95
+
a swhid is made of its scheme version, its kind and its hash. They're
96
+
documented
97
+
{{:https://docs.softwareheritage.org/devel/swh-model/persistent-identifiers.html#core-identifiers}
98
+
here}. *)
99
+
100
+
(** The type of core identifiers. *)
101
+
type t
102
+
103
+
(** [compare x y] returns [0] if [x] is equal to [y], a negative integer if
104
+
[x] is less than [y], and a positive integer if [x] is greater than [y]. *)
105
+
val compare : t -> t -> int
106
+
107
+
(** [equal x y] returns [true] iff [x] is equal to [y]. *)
108
+
val equal : t -> t -> bool
109
+
110
+
(** [of_string s] is [Ok v] if [s] is a valid core identifier, otherwise it is
111
+
[Error e]. *)
112
+
val of_string : string -> (t, string) result
113
+
114
+
(** [mk scheme kind hash] is the core identifier made of the scheme version
115
+
[scheme], the kind [kind] and the hash [hash]. *)
116
+
val mk : Scheme_version.t -> Kind.t -> Hash.t -> t
117
+
118
+
(** [pp fmt v] prints [v] on formatter [fmt]. *)
119
+
val pp : Format.formatter -> t -> unit
120
+
121
+
(** [to_string v] is the representation of [v] as a string. *)
122
+
val to_string : t -> string
123
+
124
+
(** [get_scheme v] is the scheme version of [v]. *)
125
+
val get_scheme : t -> Scheme_version.t
126
+
127
+
(** [get_kind v] is the kind of [v] *)
128
+
val get_kind : t -> Kind.t
129
+
130
+
(** [get_hash v] is the hash of [v]. *)
131
+
val get_hash : t -> Hash.t
132
+
end
133
+
134
+
module Qualifier : sig
135
+
(** Module to work with qualifiers. They are documented
136
+
{{:https://docs.softwareheritage.org/devel/swh-model/persistent-identifiers.html#qualifiers}
137
+
here}. *)
138
+
139
+
(** The type of qualifiers. *)
140
+
type t =
141
+
| Anchor of Core_identifier.t
142
+
| Origin of string
143
+
| Path of string
144
+
| Visit of Core_identifier.t
145
+
| Fragment of (int * int option)
146
+
147
+
(** [of_string s] is [Ok v] if [s] is a valid qualifier, otherwise it is
148
+
[Error e]. *)
149
+
val of_string : string -> (t, string) result
150
+
151
+
(** [pp fmt v] prints [v] on formatter [fmt]. *)
152
+
val pp : Format.formatter -> t -> unit
153
+
154
+
(** [to_string v] is the representation of [v] as a string. *)
155
+
val to_string : t -> string
156
+
end
157
+
158
+
(** The type of swhids. *)
159
+
type t
160
+
161
+
(** [of_string s] is [Ok v] if [s] is a valid swhid, otherwise it is [Error e]. *)
162
+
val of_string : string -> (t, string) result
163
+
164
+
(** [mk c q] is the swhid made of the core identifier [c] and the list of
165
+
qualifiers [q]. *)
166
+
val mk : Core_identifier.t -> Qualifier.t list -> t
167
+
168
+
(** [get_core v] is the core identifier of [v]. *)
169
+
val get_core : t -> Core_identifier.t
170
+
171
+
(** [get_scheme v] is the scheme of [v]. *)
172
+
val get_scheme : t -> Scheme_version.t
173
+
174
+
(** [get_kind v] is the kind of [v]. *)
175
+
val get_kind : t -> Kind.t
176
+
177
+
(** [get_hash v] is the hash of [v]. *)
178
+
val get_hash : t -> Hash.t
179
+
180
+
(** [get_qualifiers v] is the list of qualifiers of [v]*)
181
+
val get_qualifiers : t -> Qualifier.t list
182
+
183
+
(** [pp fmt v] prints [v] on formatter [fmt]. *)
184
+
val pp : Format.formatter -> t -> unit
185
+
186
+
(** [to_string v] is the representation of [v] as a string. *)
187
+
val to_string : t -> string
+32
vendor/opam/swhid_core/swhid_core.opam
+32
vendor/opam/swhid_core/swhid_core.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "OCaml library to work with swhids"
4
+
description:
5
+
"swhid_core is an OCaml library to with with Software Heritage persistent identifiers (swhids). This is the core library, for most use cases you should use the swhid library instead."
6
+
maintainer: ["Léo Andrès <contact@ndrs.fr>"]
7
+
authors: [
8
+
"Léo Andrès <contact@ndrs.fr>" "Dario Pinto <dario.pinto@ocamlpro.com>"
9
+
]
10
+
license: "ISC"
11
+
homepage: "https://github.com/ocamlpro/swhid_core"
12
+
bug-reports: "https://github.com/ocamlpro/swhid_core/issues"
13
+
depends: [
14
+
"ocaml" {>= "4.03"}
15
+
"dune" {>= "1.11"}
16
+
"odoc" {with-doc}
17
+
]
18
+
build: [
19
+
["dune" "subst"] {pinned}
20
+
[
21
+
"dune"
22
+
"build"
23
+
"-p"
24
+
name
25
+
"-j"
26
+
jobs
27
+
"@install"
28
+
"@runtest" {with-test}
29
+
"@doc" {with-doc}
30
+
]
31
+
]
32
+
dev-repo: "git+https://github.com/ocamlpro/swhid_core.git"
+4
vendor/opam/swhid_core/test/dune
+4
vendor/opam/swhid_core/test/dune
+10
vendor/opam/swhid_core/test/test.ml
+10
vendor/opam/swhid_core/test/test.ml