package opam-client

  1. Overview
  2. Docs

Source file opamListCommand.ml

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
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
(**************************************************************************)
(*                                                                        *)
(*    Copyright 2012-2015 OCamlPro                                        *)
(*    Copyright 2012 INRIA                                                *)
(*                                                                        *)
(*  All rights reserved. This file is distributed under the terms of the  *)
(*  GNU Lesser General Public License version 2.1, with the special       *)
(*  exception on linking described in the file LICENSE.                   *)
(*                                                                        *)
(**************************************************************************)

open OpamCompat
open OpamTypes
open OpamStateTypes
open OpamStd.Op
open OpamPackage.Set.Op

let log fmt = OpamConsole.log "LIST" fmt
let slog = OpamConsole.slog

type dependency_toggles = {
  recursive: bool;
  depopts: bool;
  build: bool;
  post: bool;
  test: bool;
  doc: bool;
  dev: bool;
}

let default_dependency_toggles = {
  recursive = false;
  depopts = false;
  build = true;
  post = false;
  test = false;
  doc = false;
  dev = false;
}

type pattern_selector = {
  case_sensitive: bool;
  exact: bool;
  glob: bool;
  fields: string list;
  ext_fields: bool;
}

let default_pattern_selector = {
  case_sensitive = false;
  exact = false;
  glob = true;
  fields = ["name"; "synopsis"; "descr"; "tags"];
  ext_fields = false;
}

type selector =
  | Any
  | Installed
  | Root
  | Compiler
  | Available
  | Installable
  | Pinned
  | Depends_on of dependency_toggles * atom list
  | Required_by of dependency_toggles * atom list
  | Conflicts_with of package list
  | Coinstallable_with of dependency_toggles * package list
  | Solution of dependency_toggles * atom list
  | Pattern of pattern_selector * string
  | Atoms of atom list
  | Flag of package_flag
  | Tag of string
  | From_repository of repository_name list
  | Owns_file of filename

let string_of_selector =
  let (%) s col = OpamConsole.colorise col s in
  function
  | Any -> "any" % `cyan
  | Installed -> "installed" % `cyan
  | Root -> "root" % `cyan
  | Compiler -> "base" % `cyan
  | Available -> "available" % `cyan
  | Installable -> "installable" % `cyan
  | Pinned -> "pinned" % `cyan
  | Depends_on (tog,atoms) ->
    Printf.sprintf "%s(%s)"
      ((if tog.recursive then "rec-depends-on" else "depends-on") % `blue)
      (OpamStd.List.concat_map " " OpamFormula.short_string_of_atom atoms
       % `bold)
  | Required_by (tog,atoms) ->
    Printf.sprintf "%s(%s)"
      ((if tog.recursive then "rec-required-by" else "required-by") % `blue)
      (OpamStd.List.concat_map " " OpamFormula.short_string_of_atom atoms
       % `bold)
  | Conflicts_with packages ->
    Printf.sprintf "%s(%s)"
      ("conflicts" % `blue)
      ((OpamStd.List.concat_map " " OpamPackage.to_string packages) % `bold)
  | Coinstallable_with (_,packages) ->
    Printf.sprintf "%s(%s)"
      ("coinstallable" % `blue)
      ((OpamStd.List.concat_map " " OpamPackage.to_string packages) % `bold)
  | Solution (_tog,atoms) ->
    Printf.sprintf "%s(%s)"
      ("solution" % `blue)
      (OpamStd.List.concat_map " " OpamFormula.short_string_of_atom atoms
       % `bold)
  | Pattern (sel,str) ->
    let str = if sel.exact then str else Printf.sprintf "*%s*" str in
    let fctname = if sel.glob then "match" else "exact-match" in
    let fctname =
      match sel.fields with
      | [] ->  Printf.sprintf "none-%s" fctname
      | [fld] ->  Printf.sprintf "%s-%s" fld fctname
      | _ -> fctname
    in
    Printf.sprintf "%s(%s)" (fctname % `green) (str % `bold)
  | Atoms atoms ->
    OpamStd.List.concat_map ~left:"(" ~right:")" " | "
      (fun a -> OpamFormula.short_string_of_atom a % `bold) atoms
  | Flag fl ->
    Printf.sprintf "%s(%s)" ("has-flag" % `green)
      (OpamTypesBase.string_of_pkg_flag fl % `bold)
  | Tag t ->
    Printf.sprintf "%s(%s)" ("has-tag" % `green) (t % `bold)
  | From_repository r ->
    Printf.sprintf "%s(%s)" ("from-repository" % `magenta)
      (OpamStd.List.concat_map " " OpamRepositoryName.to_string r % `bold)
  | Owns_file f ->
    Printf.sprintf "%s(%s)" ("owns-file" % `magenta)
      (OpamFilename.prettify f % `bold)

let string_of_formula =
  OpamFormula.string_of_formula string_of_selector

let get_opam st nv =
  match OpamSwitchState.opam_opt st nv with
  | Some o ->
    OpamFile.OPAM.(with_name nv.OpamPackage.name
                     (with_version nv.OpamPackage.version o))
  | None -> OpamFile.OPAM.create nv

let packages_of_atoms st atoms =
  atoms |>
  OpamSolution.sanitize_atom_list ~permissive:true st |>
  OpamFormula.packages_of_atoms (st.packages ++ st.installed)

let package_dependencies st tog nv =
  get_opam st nv |>
  OpamPackageVar.all_depends
    ~build:tog.build ~post:tog.post
    ~test:tog.test ~doc:tog.doc ~dev:tog.dev
    ~depopts:tog.depopts
    st

let atom_dependencies st tog atoms =
  atoms |>
  OpamFormula.packages_of_atoms (st.packages ++ st.installed) |> fun pkgs ->
  OpamPackage.Set.fold (fun nv acc ->
      OpamFormula.ors [acc; package_dependencies st tog nv])
    pkgs OpamFormula.Empty

let get_universe st tog =
  OpamSwitchState.universe st
    ~test:tog.test ~doc:tog.doc ~force_dev_deps:tog.dev
    ~requested:(OpamPackage.names_of_packages st.packages)
    Query

let rec value_strings value =
  let module SS = OpamStd.String.Set in
  match value with
  | Bool _ | Int _ -> SS.empty
  | Ident (_, s) -> SS.singleton s
  | String (_, s) -> SS.singleton s
  | Relop (_, _, v1, v2)
  | Logop (_, _, v1, v2)
  | Env_binding (_, v1, _, v2) ->
    SS.union (value_strings v1) (value_strings v2)
  | Prefix_relop (_, _, v)
  | Pfxop (_, _, v) ->
    value_strings v
  | List (_, l)
  | Group (_, l) ->
    List.fold_left (fun acc v -> SS.union acc (value_strings v))
      SS.empty l
  | Option (_, v, vl) ->
    List.fold_left (fun acc v -> SS.union acc (value_strings v))
      (value_strings v) vl

let pattern_selector patterns =
  let name_patt =
    { default_pattern_selector with exact = true; fields = ["name"] }
  in
  let version_patt =
    { default_pattern_selector with exact = true; fields = ["version"] }
  in
  OpamFormula.ors
    (List.map (fun patt ->
         match OpamStd.String.cut_at patt '.' with
         | None ->
           Atom (Pattern (name_patt, patt))
         | Some (name, version) ->
           OpamFormula.ands
             [Atom (Pattern (name_patt, name));
              Atom (Pattern (version_patt, version))])
        patterns)

let apply_selector ~base st = function
  | Any -> base
  | Installed -> st.installed
  | Root -> st.installed_roots
  | Compiler -> st.compiler_packages
  | Available -> Lazy.force st.available_packages
  | Installable ->
    OpamSolver.installable
      (OpamSwitchState.universe st ~requested:OpamPackage.Name.Set.empty Query)
  | Pinned -> OpamPinned.packages st
  | (Required_by ({recursive=true; _} as tog, atoms)
    | Depends_on ({recursive=true; _} as tog, atoms)) as direction ->
    let deps_fun = match direction with
      | Required_by _ -> OpamSolver.dependencies
      | Depends_on _ -> OpamSolver.reverse_dependencies
      | _ -> assert false
    in
    deps_fun ~depopts:tog.depopts ~build:tog.build ~post:tog.post
      ~installed:false ~unavailable:true
      (get_universe st tog)
      (packages_of_atoms st atoms)
    |> OpamPackage.Set.of_list
  | Required_by (tog, atoms) ->
    atom_dependencies st tog atoms |>
    OpamFormula.packages base
  | Depends_on (tog, atoms) ->
    let packages = packages_of_atoms st atoms in
    OpamPackage.Set.filter (fun nv ->
        OpamPackage.Set.exists
          (OpamFormula.verifies (package_dependencies st tog nv))
          packages)
      base
  | Conflicts_with packages ->
    OpamSwitchState.conflicts_with st (OpamPackage.Set.of_list packages)
      (Lazy.force st.available_packages)
  | Coinstallable_with (tog, packages) ->
    let universe = get_universe st tog in
    let set = OpamPackage.Set.of_list packages in
    let universe = { universe with u_base = set; u_installed = set } in
    OpamSolver.installable_subset universe base
  | Solution (tog, atoms) ->
    let universe = get_universe st tog in
    let universe =
      { universe
        with u_installed = OpamPackage.Set.empty;
             u_installed_roots = OpamPackage.Set.empty }
    in
    (match OpamSolver.resolve universe ~orphans:OpamPackage.Set.empty
             (OpamSolver.request ~install:atoms ()) with
    | Success s -> OpamSolver.new_packages s
    | Conflicts cs ->
      OpamConsole.error_and_exit `No_solution
        "No solution%s for %s: %s"
        (if tog.depopts then " including optional dependencies" else "")
        (OpamFormula.string_of_atoms atoms)
        (OpamCudf.string_of_conflict st.packages
           (OpamSwitchState.unavailable_reason st) cs))
  | Pattern (psel, pat) ->
    let re =
      if psel.glob then Re.Glob.glob ~expand_braces:true pat
      else Re.str pat
    in
    let re = if psel.case_sensitive then Re.case re else Re.no_case re in
    let re = if psel.exact then Re.seq [Re.bos; re; Re.eos] else re in
    let re = Re.compile re in
    let content_strings nv =
      let opam = get_opam st nv in
      if psel.fields = [] then
        List.map (fun (_,v) -> value_strings v) (OpamFile.OPAM.to_list opam)
      else
      try
        List.map
          (fun f -> match OpamFile.OPAM.print_field_as_syntax f opam with
             | None -> OpamStd.String.Set.empty
             | Some v -> value_strings v)
          psel.fields
      with Not_found ->
        OpamConsole.error_and_exit `Bad_arguments
          "Unrecognised field in selection %s"
          (String.concat ", " psel.fields)
    in
    OpamPackage.Set.filter
      (fun nv -> List.exists (OpamStd.String.Set.exists (Re.execp re))
          (content_strings nv))
      base
  | Atoms atoms ->
    OpamFormula.packages_of_atoms base atoms
  | Flag f ->
    OpamPackage.Set.filter (fun nv ->
        get_opam st nv |> OpamFile.OPAM.has_flag f)
      base
  | Tag t ->
    OpamPackage.Set.filter (fun nv ->
        get_opam st nv |> List.mem t @* OpamFile.OPAM.tags)
      base
  | From_repository repos ->
    let rt = st.switch_repos in
    let rec aux = function
      | [] -> OpamPackage.Set.empty
      | r :: rl ->
        let packages =
          OpamPackage.keys (OpamRepositoryName.Map.find r rt.repo_opams)
        in
        if List.mem r repos then OpamPackage.Set.union packages (aux rl)
        else OpamPackage.Set.diff (aux rl) packages
    in
    aux (OpamSwitchState.repos_list st)
  | Owns_file file ->
    (try
       let root = st.switch_global.root in
       let switch =
        List.find (fun sw ->
            OpamFilename.remove_prefix (OpamPath.Switch.root root sw) file
            <> OpamFilename.to_string file)
          (OpamFile.Config.installed_switches st.switch_global.config)
       in
       let rel_name =
         OpamFilename.remove_prefix (OpamPath.Switch.root root switch) file
       in
       let matching_change_files =
         List.filter (fun change_f ->
             OpamFilename.check_suffix change_f ".changes" &&
             let changes =
               OpamFile.Changes.safe_read (OpamFile.make change_f)
             in
             OpamStd.String.Map.exists
               (fun f -> function
                  | OpamDirTrack.Removed -> false
                  | _ -> rel_name = f)
               changes)
           (OpamFilename.files (OpamPath.Switch.install_dir root switch))
       in
       let selections =
         if switch = st.switch then OpamSwitchState.selections st
         else OpamSwitchState.load_selections st.switch_global switch
       in
       List.fold_left (fun acc f ->
           let name =
             OpamPackage.Name.of_string @@
             OpamFilename.(Base.to_string (basename (chop_extension f)))
           in
           try
             OpamPackage.Set.add
               (OpamPackage.package_of_name selections.sel_installed name)
               acc
           with Not_found -> acc)
         OpamPackage.Set.empty matching_change_files
     with Not_found ->
       log "%a doesn't belong to a known opam switch"
         (slog OpamFilename.to_string) file;
       OpamPackage.Set.empty)


let rec filter ~base st = function
  | Empty -> base
  | Atom select -> apply_selector ~base st select
  | Block b -> filter ~base st b
  | And (a, b) ->
    let base = filter ~base st a in
    base %% filter ~base st b
  | Or (a, b) -> filter ~base st a ++ filter ~base st b

type output_format =
  | Name
  | Version
  | Package
  | Synopsis
  | Synopsis_or_target
  | Description
  | Field of string
  | Installed_version
  | Pinning_target
  | Source_hash
  | Raw
  | All_installed_versions
  | Available_versions
  | All_versions
  | Repository
  | Installed_files
  | VC_ref
  | Depexts

let default_list_format = [Name; Installed_version; Synopsis_or_target]

let disp_header = function
  | Name -> "Name"
  | Version -> "Version"
  | Package -> "Package"
  | Synopsis | Synopsis_or_target -> "Synopsis"
  | Description -> "Description"
  | Field s -> String.capitalize_ascii s
  | Installed_version -> "Installed"
  | Pinning_target -> "Pin"
  | Source_hash -> "Source hash"
  | Raw -> "Metadata"
  | All_installed_versions -> "Installed versions"
  | Available_versions -> "Available versions"
  | All_versions -> "Versions"
  | Repository -> "Repository"
  | Installed_files -> "Installed files"
  | VC_ref -> "VC ref"
  | Depexts -> "Depexts"

let field_names = [
  Name, "name";
  Version, "version";
  Package, "package";
  Synopsis, "synopsis";
  Synopsis_or_target, "synopsis-or-target";
  Description, "description";
  Field "<field>", "<field>:";
  Installed_version, "installed-version";
  Pinning_target, "pin";
  Source_hash, "source-hash";
  Raw, "opam-file";
  All_installed_versions, "all-installed-versions";
  Available_versions, "available-versions";
  All_versions, "all-versions";
  Repository, "repository";
  Installed_files, "installed-files";
  VC_ref, "vc-ref";
  Depexts, "depexts";
]

let string_of_field = function
  | Field s -> s^":"
  | f -> List.assoc f field_names

let field_of_string =
  let names_fields = List.map (fun (a,b) -> b, a) field_names in
  fun s ->
    if OpamStd.String.ends_with ~suffix:":" s then
      Field (OpamStd.String.remove_suffix ~suffix:":" s)
    else
    try List.assoc s names_fields
    with Not_found ->
      OpamConsole.error_and_exit `Bad_arguments
        "No printer for %S%s" s
        (if not (OpamStd.String.ends_with ~suffix:":" s) &&
            List.mem_assoc s (OpamFile.OPAM.fields)
         then Printf.sprintf ". Did you mean the opam field \"%s:\" \
                              (with a colon)?" s
         else "")

let version_color st nv =
  let installed = (* (in any switch) *)
    OpamGlobalState.installed_versions st.switch_global nv.name
  in
  let is_available nv = (* Ignore unavailability due to pinning *)
    try
      OpamFilter.eval_to_bool ~default:false
        (OpamPackageVar.resolve_switch_raw ~package:nv st.switch_global
           st.switch st.switch_config)
        (OpamFile.OPAM.available (get_opam st nv))
    with Not_found -> false
  in
  if OpamPackage.Set.mem nv st.installed then [`bold;`magenta] else
    (if OpamPackage.Map.mem nv installed then [`bold] else []) @
    (if is_available nv then [] else [`crossed;`red])

let mini_field_printer ?(prettify=false) ?(normalise=false) =
  if normalise then OpamPrinter.Normalise.value else
  function
  | String (_, s) when prettify -> s
  | List (_, l) when prettify &&
                     List.for_all (function String _ -> true | _ -> false) l ->
    OpamStd.List.concat_map ", " (function String (_, s) -> s | _ -> assert false) l
  | List (_, l) -> OpamPrinter.value_list l
  | f -> OpamPrinter.Normalise.value f

let detail_printer ?prettify ?normalise st nv =
  let open OpamStd.Option.Op in
  let (%) s cols = OpamConsole.colorise' cols s in
  let root_sty =
    if OpamPackage.Set.mem nv st.installed_roots then [`underline]
    else []
  in
  function
  | Name -> OpamPackage.Name.to_string nv.name % (`bold :: root_sty)
  | Version -> OpamPackage.Version.to_string nv.version % version_color st nv
  | Package ->
    (OpamPackage.name_to_string nv % (`bold :: root_sty)) ^
    ("." ^ OpamPackage.version_to_string nv) % root_sty
  | Synopsis ->
    (get_opam st nv |>
     OpamFile.OPAM.descr >>| OpamFile.Descr.synopsis)
    +! ""
  | Synopsis_or_target ->
    (match OpamPinned.package_opt st nv.name with
     | Some nv ->
       let opam = get_opam st nv in
       if Some opam = OpamPackage.Map.find_opt nv st.repos_package_index then
         Printf.sprintf "pinned to version %s"
           (OpamPackage.Version.to_string nv.version % [`blue])
       else
         Printf.sprintf "pinned to version %s at %s"
           (OpamPackage.Version.to_string nv.version % [`blue])
           (OpamStd.Option.to_string ~none:"(local metadata only)"
              (fun u -> OpamUrl.to_string u % [`underline])
              (OpamFile.OPAM.get_url opam))
     | None ->
       (get_opam st nv |>
        OpamFile.OPAM.descr >>| OpamFile.Descr.synopsis)
       +! "")
  | Description ->
    (get_opam st nv |>
     OpamFile.OPAM.descr >>|
     OpamFile.Descr.body)
    +! ""
  | Field f ->
    (try
       List.assoc f (OpamFile.OPAM.to_list (get_opam st nv)) |>
       mini_field_printer ?prettify ?normalise
     with Not_found -> "")
  | Installed_version ->
    (try OpamPackage.package_of_name st.installed nv.name |> fun inst_nv ->
         OpamPackage.version_to_string inst_nv |> fun s ->
         if OpamPackage.Set.mem inst_nv st.pinned then s % [`blue] else
         if OpamPackage.has_name st.pinned nv.name then s % [`bold;`red] else
         if nv <> inst_nv &&
            not (OpamPackage.Set.mem inst_nv st.compiler_packages)
         then s % [`bold;`yellow] else
           s % [`magenta]
     with Not_found -> "--" % [`cyan])
  | Pinning_target ->
    if OpamPackage.Set.mem nv st.pinned then
      let opam = get_opam st nv in
      OpamStd.Option.to_string ~none:"--" OpamUrl.to_string
        (OpamFile.OPAM.get_url opam)
    else ""
  | Source_hash ->
    let hash_opt =
      let open OpamStd.Option.Op in
      OpamSwitchState.url st nv >>| OpamFile.URL.url >>= fun url ->
      OpamSwitchState.source_dir st nv |>
      OpamFilename.opt_dir >>= fun srcdir ->
      OpamProcess.Job.run (OpamRepository.revision srcdir url) >>|
      OpamPackage.Version.to_string
    in
    OpamStd.Option.default "" hash_opt
  | Raw -> OpamFile.OPAM.write_to_string (get_opam st nv)
  | All_installed_versions ->
    OpamGlobalState.installed_versions st.switch_global nv.name |>
    OpamPackage.Map.mapi (fun nv switches ->
        Printf.sprintf "%s [%s]"
          (OpamPackage.version_to_string nv % version_color st nv)
          (String.concat " " (List.map OpamSwitch.to_string switches))) |>
    OpamPackage.Map.values |>
    String.concat "  "
  | Available_versions ->
    let available =
      OpamPackage.packages_of_name (Lazy.force st.available_packages) nv.name
    in
    OpamStd.List.concat_map "  " (fun nv ->
        OpamPackage.Version.to_string nv.version % version_color st nv)
      (OpamPackage.Set.elements available)
  | All_versions ->
    let pkgs = OpamPackage.packages_of_name st.packages nv.name in
    OpamStd.List.concat_map "  " (fun nv ->
        OpamPackage.Version.to_string nv.version % version_color st nv)
      (OpamPackage.Set.elements pkgs)
  | Repository ->
    OpamRepositoryState.find_package_opt st.switch_repos
      (OpamSwitchState.repos_list st) nv |>
    OpamStd.Option.to_string (fun (r, _) -> OpamRepositoryName.to_string r)
  | Installed_files ->
    let changes_f =
      OpamPath.Switch.changes st.switch_global.root st.switch nv.name
    in
    (match OpamFile.Changes.read_opt changes_f with
     | None -> ""
     | Some c ->
       OpamStd.Format.itemize ~bullet:""
         (fun (file, status) ->
            OpamFilename.to_string file ^ match status with
            | `Unchanged -> ""
            | `Removed -> " (absent)" % [`red]
            | `Changed -> " (modified since)" % [`yellow])
         (OpamDirTrack.check
            (OpamPath.Switch.root st.switch_global.root st.switch)
            c))
  | VC_ref ->
    OpamStd.Option.Op.(
      (OpamSwitchState.url st nv >>| OpamFile.URL.url >>= fun url ->
       url.OpamUrl.hash)
      +! ""
    )
  | Depexts ->
    String.concat " "
      (OpamStd.String.Set.elements (OpamSwitchState.depexts st nv))

type package_listing_format = {
  short: bool;
  header: bool;
  columns: output_format list;
  all_versions: bool;
  wrap: [`Wrap of string | `Truncate | `None] option;
  separator: string;
  value_printer: [`Normal | `Pretty | `Normalised];
  order: [`Standard | `Dependency | `Custom of package -> package -> int];
}

let default_package_listing_format = {
  short = false;
  header = true;
  columns = default_list_format;
  all_versions = false;
  wrap = None;
  separator = " ";
  value_printer = `Normal;
  order = `Standard;
}

let display st format packages =
  let packages =
    if format.all_versions then packages else
      OpamPackage.Name.Set.fold (fun name ->
          let pkgs = OpamPackage.packages_of_name packages name in
          let nv =
            let get = OpamPackage.Set.max_elt in
            try get (pkgs %% st.installed) with Not_found ->
            try get (pkgs %% st.pinned) with Not_found ->
            try get (pkgs %% Lazy.force st.available_packages) with Not_found ->
              get pkgs
          in
          OpamPackage.Set.add nv)
        (OpamPackage.names_of_packages packages)
        OpamPackage.Set.empty
  in
  let packages =
    if format.order = `Dependency then
      let universe =
        OpamSwitchState.universe st
          ~requested:(OpamPackage.names_of_packages packages)
          Query
      in
      let deps_packages =
        OpamSolver.dependencies
          ~depopts:true ~installed:false ~unavailable:true
          ~build:true ~post:false
          universe packages
      in
      List.filter (fun nv -> OpamPackage.Set.mem nv packages) deps_packages |>
      List.rev
    else match format.order with
      | `Custom o -> List.sort o (OpamPackage.Set.elements packages)
      | _ -> OpamPackage.Set.elements packages
  in
  let add_head l =
    if format.header then
      (List.map (fun f -> "# "^disp_header f) format.columns)
      :: l
    else l
  in
  let prettify = format.value_printer = `Pretty in
  let normalise = format.value_printer = `Normalised in
  if packages = [] then
    (if format.header then
       OpamConsole.errmsg "%s\n"
         (OpamConsole.colorise `red "# No matches found"))
  else
    List.rev_map (fun nv ->
        List.map (detail_printer ~prettify ~normalise st nv) format.columns)
      packages |>
    List.rev |>
    add_head |>
    OpamStd.Format.align_table |>
    OpamConsole.print_table ?cut:format.wrap stdout ~sep:format.separator

let get_switch_state gt =
  let rt = OpamRepositoryState.load `Lock_none gt in
  match OpamStateConfig.get_switch_opt () with
  | None -> OpamSwitchState.load_virtual gt rt
  | Some sw -> OpamSwitchState.load `Lock_none gt rt sw

let get_depexts st packages =
  OpamPackage.Name.Set.fold
    (fun name acc ->
       let nv = OpamSwitchState.get_package st name in
       let nv =
         if OpamPackage.Set.mem nv packages then nv else
           OpamPackage.Set.max_elt (OpamPackage.packages_of_name packages name)
       in
       OpamStd.String.Set.union acc
         (OpamSwitchState.depexts st nv))
    (OpamPackage.names_of_packages packages)
    OpamStd.String.Set.empty

let print_depexts =
  OpamStd.String.Set.iter (OpamConsole.msg "%s\n")

let info st ~fields ~raw_opam ~where ?normalise ?(show_empty=false) atoms =
  let packages =
    OpamFormula.packages_of_atoms (st.packages ++ st.installed) atoms
  in
  if OpamPackage.Set.is_empty packages then
    (OpamConsole.error "No package matching %s found"
       (OpamStd.List.concat_map " or " OpamFormula.short_string_of_atom atoms);
     OpamStd.Sys.exit_because `Not_found);
  let fields = List.map field_of_string fields in
  let all_versions_fields = [
    Name;
    All_installed_versions;
    All_versions;
  ] in
  let one_version_fields = [
    Version;
    Repository;
    Pinning_target;
    Source_hash;
    Field "url.src";
    Field "url.checksum";
    Field "homepage";
    Field "bug-reports";
    Field "dev-repo";
    Field "authors";
    Field "maintainer";
    Field "license";
    Field "tags";
    Field "flags";
    Field "depends";
    Field "depopts";
    Field "conflicts";
    Field "conflict-class";
    Synopsis;
    Description;
  ] in
  let output_table fields nv =
    let tbl =
      List.fold_left (fun acc item ->
          let contents = detail_printer ?normalise st nv item in
          if show_empty || contents <> "" then
            [ OpamConsole.colorise `blue (string_of_field item); contents ]
            :: acc
          else acc)
        [] (List.rev fields)
    in
    OpamStd.Format.align_table tbl |>
    OpamConsole.print_table stdout ~sep:" ";
  in
  OpamPackage.names_of_packages packages |>
  OpamPackage.Name.Set.iter (fun name ->
      (* Like OpamSwitchState.get_package, but restricted to [packages] *)
      let nvs = OpamPackage.packages_of_name packages name in
      let choose =
        try OpamPackage.Set.choose (nvs %% st.pinned) with Not_found ->
        try OpamPackage.Set.choose (nvs %% st.installed) with Not_found ->
        try OpamPackage.Set.max_elt (nvs %% Lazy.force st.available_packages)
        with Not_found ->
          OpamPackage.Set.max_elt nvs
      in
      let opam = get_opam st choose in
      OpamFile.OPAM.print_errors opam;
      if where then
        OpamConsole.msg "%s\n"
          (match OpamFile.OPAM.metadata_dir opam with
           | Some dir ->
             OpamFilename.Dir.to_string OpamFilename.Op.(dir / "opam")
           | None -> "<nowhere>")
      else if raw_opam then
        OpamFile.OPAM.write_to_channel stdout opam
      else
      match fields with
      | [] ->
        OpamConsole.header_msg "%s: information on all versions"
          (OpamPackage.Name.to_string choose.name);
        output_table all_versions_fields choose;
        OpamConsole.header_msg "Version-specific details";
        output_table one_version_fields choose
      | [f] -> OpamConsole.msg "%s\n" (detail_printer ?normalise st choose f)
      | fields -> output_table fields choose
    )
OCaml

Innovation. Community. Security.