1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
|
open Stdune
include Cmdliner.Arg
include struct
open Dune_lang
module Stanza = Stanza
module String_with_vars = String_with_vars
module Profile = Profile
module Pform = Pform
module Lib_name = Lib_name
module Dep_conf = Dep_conf
end
module Package = Dune_lang.Package
module Context_name = Dune_engine.Context_name
let package_name = conv Package.Name.conv
module Path = struct
module External = struct
type t = string
let path p = Path.External.of_filename_relative_to_initial_cwd p
let arg s = s
let conv = conv ((fun p -> Ok p), Format.pp_print_string)
end
type t = string
let path p = Path.of_filename_relative_to_initial_cwd p
let arg s = s
let conv = conv ((fun p -> Ok p), Format.pp_print_string)
end
let path = Path.conv
let external_path = Path.External.conv
let profile = conv Profile.conv
module Dep = struct
module Dep_conf = Dep_conf
type t = Dep_conf.t
let equal = Dep_conf.equal
let file s = Dep_conf.File (String_with_vars.make_text Loc.none s)
let make_alias_sw ~dir s =
let path =
Dune_engine.Alias.Name.to_string s
|> Stdune.Path.Local.relative dir
|> Stdune.Path.Local.to_string
in
String_with_vars.make_text Loc.none path
;;
let alias ~dir s = Dep_conf.Alias (make_alias_sw ~dir s)
let alias_rec ~dir s = Dep_conf.Alias_rec (make_alias_sw ~dir s)
let parse_alias s =
if not (String.is_prefix s ~prefix:"@")
then None
else (
let pos, recursive =
if String.length s >= 2 && s.[1] = '@' then 2, false else 1, true
in
let s = String_with_vars.make_text Loc.none (String.drop s pos) in
Some (if recursive then Dep_conf.Alias_rec s else Dep_conf.Alias s))
;;
let dep_parser =
Dune_lang.Syntax.set
Stanza.syntax
(Active Stanza.latest_version)
(String_with_vars.set_decoding_env
(Pform.Env.initial ~stanza:Stanza.latest_version ~extensions:[])
Dep_conf.decode)
;;
let parser s =
match parse_alias s with
| Some dep -> Ok dep
| None ->
(match
Dune_lang.Decoder.parse
dep_parser
Univ_map.empty
(Dune_lang.Parser.parse_string
~fname:"command line"
~mode:Dune_lang.Parser.Mode.Single
s)
with
| x -> Ok x
| exception User_error.E msg -> Error (User_message.to_string msg))
;;
let string_of_alias ~recursive sv =
let prefix = if recursive then "@" else "@@" in
String_with_vars.text_only sv |> Option.map ~f:(fun s -> prefix ^ s)
;;
let printer ppf t =
let s =
match t with
| Dep_conf.Alias sv -> string_of_alias ~recursive:false sv
| Alias_rec sv -> string_of_alias ~recursive:true sv
| File sv -> Some (Dune_lang.to_string (String_with_vars.encode sv))
| _ -> None
in
let s =
match s with
| Some s -> s
| None -> Dune_lang.to_string (Dep_conf.encode t)
in
Format.pp_print_string ppf s
;;
let conv = conv' (parser, printer)
let to_string_maybe_quoted t = String.maybe_quoted (Format.asprintf "%a" printer t)
let alias_arg =
let parse x = Ok (Dep_conf.Alias (String_with_vars.make_text Loc.none x)) in
conv' (parse, printer)
;;
let alias_rec_arg =
let parse x = Ok (Dep_conf.Alias_rec (String_with_vars.make_text Loc.none x)) in
conv' (parse, printer)
;;
end
let dep = Dep.conv
let bytes =
let decode repr =
let ast =
Dune_lang.Parser.parse_string
~fname:"command line"
~mode:Dune_lang.Parser.Mode.Single
repr
in
match Dune_lang.Decoder.parse Dune_lang.Decoder.bytes_unit Univ_map.empty ast with
| x -> Result.Ok x
| exception User_error.E msg -> Result.Error (`Msg (User_message.to_string msg))
in
let pp_print_int64 state i = Format.pp_print_string state (Int64.to_string i) in
conv (decode, pp_print_int64)
;;
let graph_format : Dune_graph.Graph.File_format.t conv =
conv Dune_graph.Graph.File_format.conv
;;
let context_name : Context_name.t conv = conv Context_name.conv
let lib_name = conv Lib_name.conv
let version = pair ~sep:'.' int int
|
