package opam-client

  1. Overview
  2. Docs

Source file opamSwitchCommand.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
782
783
784
785
786
787
788
789
790
791
792
(**************************************************************************)
(*                                                                        *)
(*    Copyright 2012-2020 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 OpamTypes
open OpamStateTypes
open OpamPackage.Set.Op
open OpamStd.Op

module S = OpamFile.SwitchSelections

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

let list gt ~print_short =
  log "list";
  let gt = OpamGlobalState.fix_switch_list gt in
  if print_short then
    List.iter (OpamConsole.msg "%s\n" @* OpamSwitch.to_string)
      (List.sort compare (OpamFile.Config.installed_switches gt.config))
  else
  let installed_switches =
    OpamGlobalState.fold_switches (fun sw sel acc ->
        let opams =
          OpamPackage.Set.fold (fun nv acc ->
              match
                OpamFile.OPAM.read_opt
                  (OpamPath.Switch.installed_opam gt.root sw nv)
              with
              | Some opam -> OpamPackage.Map.add nv opam acc
              | None -> acc)
            sel.sel_compiler OpamPackage.Map.empty
        in
        let ifempty default m =
          if OpamPackage.Map.is_empty m then default else m
        in
        let comp =
          OpamPackage.Map.filter
            (fun nv _ -> OpamPackage.Set.mem nv sel.sel_compiler)
            opams
          |> ifempty opams
        in
        let comp =
          OpamPackage.Map.filter
            (fun _ opam -> OpamFile.OPAM.has_flag Pkgflag_Compiler opam)
            comp
          |> ifempty comp
        in
        let conf =
          OpamStateConfig.Switch.read_opt ~lock_kind:`Lock_read gt sw
        in
        let descr = match conf with
          | Some c -> c.OpamFile.Switch_config.synopsis
          | None -> OpamConsole.colorise `red "Missing config file"
        in
        OpamSwitch.Map.add sw (OpamPackage.keys comp, descr) acc)
      gt
      OpamSwitch.Map.empty
  in
  let list = OpamSwitch.Map.bindings installed_switches in

  let table =
    List.map (OpamConsole.colorise `blue)
      ["#"; "switch"; "compiler"; "description" ] ::
    List.map (fun (switch, (packages, descr)) ->
        let current = Some switch = OpamStateConfig.get_switch_opt () in
        List.map
          (if current then OpamConsole.colorise `bold else fun s -> s)
          [ if current then
              OpamConsole.(utf8_symbol Symbols.rightwards_arrow "->")
            else "";
            OpamSwitch.to_string switch;
            OpamStd.List.concat_map ","
              (OpamConsole.colorise `yellow @* OpamPackage.to_string)
              (OpamPackage.Set.elements packages);
            descr ])
      list
  in
  OpamConsole.print_table stdout ~sep:"  "
    (OpamStd.Format.align_table table);

  match OpamStateConfig.get_switch_opt (), OpamStateConfig.(!r.switch_from)
  with
  | None, _ when OpamFile.Config.installed_switches gt.config <> [] ->
    OpamConsole.note
      "No switch is currently set, you should use 'opam switch <switch>' \
       to set an active switch"
  | Some switch, `Env ->
    let sys = OpamFile.Config.switch gt.config in
    if not (OpamGlobalState.switch_exists gt switch) then
      (OpamConsole.msg "\n";
       OpamConsole.warning
         "The OPAMSWITCH variable does not point to a valid switch: %S"
         (OpamSwitch.to_string switch))
    else if sys <> Some switch then
      (OpamConsole.msg "\n";
       OpamConsole.note
         "Current switch is set locally through the OPAMSWITCH variable.\n\
          The current global system switch is %s."
         (OpamStd.Option.to_string ~none:"unset"
            (fun s -> OpamConsole.colorise `bold (OpamSwitch.to_string s)) sys))
    else
      (match OpamStateConfig.get_current_switch_from_cwd gt.root with
       | None -> ()
       | Some sw ->
         OpamConsole.msg "\n";
         OpamConsole.note
           "Current switch is set globally and through the OPAMSWITCH variable.\n\
            Thus, the local switch found at %s was ignored."
           (OpamConsole.colorise `bold (OpamSwitch.to_string sw)))
  | Some switch, `Default when not (OpamGlobalState.switch_exists gt switch) ->
    OpamConsole.msg "\n";
    OpamConsole.warning
      "The currently selected switch (%S) is invalid.\n%s"
      (OpamSwitch.to_string switch)
      (if OpamSwitch.is_external switch
       then "Stale '_opam' directory or link ?"
       else "Fix the selection with 'opam switch set SWITCH'.")
  | Some switch, `Default when OpamSwitch.is_external switch ->
    OpamConsole.msg "\n";
    OpamConsole.note
      "Current switch has been selected based on the current directory.\n\
       The current global system switch is %s."
      (OpamStd.Option.to_string ~none:"unset"
         (fun s -> OpamConsole.colorise `bold (OpamSwitch.to_string s))
         (OpamFile.Config.switch gt.config));
    if not (OpamEnv.is_up_to_date_switch gt.root switch) then
      OpamConsole.warning
        "The environment is not in sync with the current switch.\n\
         You should run: %s"
        (OpamEnv.eval_string gt (Some switch))
  | Some switch, `Default ->
    if not (OpamEnv.is_up_to_date_switch gt.root switch) then
      (OpamConsole.msg "\n";
       OpamConsole.warning
         "The environment is not in sync with the current switch.\n\
          You should run: %s"
         (OpamEnv.eval_string gt (Some switch)))
  | _ -> ()

let clear_switch ?(keep_debug=false) (gt: rw global_state) switch =
  let module C = OpamFile.Config in
  let config = gt.config in
  let config =
    C.with_installed_switches
      (List.filter ((<>) switch) (C.installed_switches config))
      config
  in
  let config =
    if C.switch config = Some switch then C.with_switch_opt None config
    else config
  in
  let gt = { gt with config } in
  OpamGlobalState.write gt;
  let comp_dir = OpamPath.Switch.root gt.root switch in
  if keep_debug && (OpamClientConfig.(!r.keep_build_dir) || (OpamConsole.debug ())) then
    (OpamConsole.note "Keeping %s despite errors (debug mode), \
                       you may want to remove it by hand"
       (OpamFilename.Dir.to_string comp_dir);
     gt)
  else
  try OpamFilename.rmdir comp_dir; gt
  with OpamSystem.Internal_error _ -> gt

let remove gt ?(confirm = true) switch =
  log "remove switch=%a" (slog OpamSwitch.to_string) switch;
  if not (OpamGlobalState.switch_exists gt switch) then (
    OpamConsole.msg "The compiler switch %s does not exist.\n"
      (OpamSwitch.to_string switch);
    OpamStd.Sys.exit_because `Not_found;
  );
  if not confirm ||
     OpamConsole.confirm
       "Switch %s and all its packages will be wiped. Are you sure?"
       (OpamSwitch.to_string switch)
  then
    clear_switch gt switch
  else gt

let set_invariant_raw st invariant =
  let switch_config = {st.switch_config with invariant = Some invariant} in
  let st = {st with switch_invariant = invariant; switch_config } in
  if not (OpamStateConfig.(!r.dryrun) || OpamClientConfig.(!r.show)) then
    OpamSwitchAction.install_switch_config st.switch_global.root st.switch
      switch_config;
  st

let install_compiler
    ?(additional_installs=[]) ?(deps_only=false) ?(ask=false) t =
  let invariant = t.switch_invariant in
  if invariant = OpamFormula.Empty && additional_installs = [] then begin
    (if not OpamClientConfig.(!r.show) &&
        not OpamStateConfig.(!r.dryrun) then
       OpamFile.Environment.write
         (OpamPath.Switch.environment t.switch_global.root t.switch)
         (OpamEnv.compute_updates t);
     OpamEnv.check_and_print_env_warning t);
    t
  end else
  let atoms = OpamFormula.atoms invariant in
  let names_of_atoms at = OpamPackage.Name.Set.of_list (List.map fst at) in
  let comp_roots = names_of_atoms atoms in
  let add_names = names_of_atoms additional_installs in
  let roots =
    OpamPackage.Name.Set.union comp_roots add_names
  in
  OpamConsole.header_msg "Installing new switch packages";
  OpamConsole.msg "Switch invariant: %s\n"
    (OpamFileTools.dep_formula_to_string invariant);
  let solution =
    OpamSolution.resolve t Switch
      ~requested:(OpamPackage.packages_of_names t.packages roots)
      (OpamSolver.request ~install:additional_installs ())
  in
  let solution = match solution with
    | Success s -> s
    | Conflicts cs ->
      OpamConsole.error
        "Could not determine which packages to install for this switch:";
      OpamConsole.errmsg "%s\n"
        (OpamCudf.string_of_conflicts t.packages
           (OpamSwitchState.unavailable_reason t) cs);
      OpamStd.Sys.exit_because `No_solution
  in
  let () = match OpamSolver.stats solution with
    | { s_install = _; s_reinstall = 0; s_upgrade = 0;
        s_downgrade=0; s_remove = 0 } -> ()
    | stats ->
      OpamConsole.error_and_exit `No_solution
        "Inconsistent resolution of packages:\n%s"
        (OpamSolver.string_of_stats stats)
  in
  if invariant = OpamFormula.Empty then
    OpamConsole.note
      "No invariant was set, you may want to use `opam switch set-invariant' \
       to keep a stable compiler version on upgrades.";
  let t =
    if t.switch_config.OpamFile.Switch_config.synopsis = "" then
      let synopsis =
        if invariant = OpamFormula.Empty then
          OpamSwitch.to_string t.switch
        else
          OpamFormula.to_string invariant
      in
      let switch_config =
        { t.switch_config with OpamFile.Switch_config.synopsis }
      in
      if not (OpamStateConfig.(!r.dryrun) || OpamClientConfig.(!r.show)) then
        OpamSwitchAction.install_switch_config t.switch_global.root t.switch
          switch_config;
      { t with switch_config }
    else t
  in
  let t =
    let base_comp =
      OpamSwitchState.compute_invariant_packages
        { t with installed = t.installed
                             -- (OpamSolver.removed_packages solution)
                             ++ (OpamSolver.new_packages solution) }
    in
    { t with compiler_packages = base_comp }
  in
  let skip =
    if deps_only then
      let pkgs =
        OpamPackage.packages_of_names (OpamSolver.new_packages solution)
          add_names
      in
      OpamPackage.Set.fold (fun nv map -> OpamPackage.Map.add nv nv map)
        pkgs OpamPackage.Map.empty
    else OpamPackage.Map.empty
  in
  let t, result =
    OpamSolution.apply t
      ~ask:(OpamClientConfig.(!r.show) || ask)
      ~requested:(OpamPackage.packages_of_names t.packages roots)
      ~add_roots:roots ~skip
      solution in
  OpamSolution.check_solution ~quiet:OpamClientConfig.(not !r.show) t
    (Success result);
  OpamSwitchAction.write_selections t;
  t

let create
    gt ~rt ?synopsis ?repos ~update_config ~invariant switch post =
  let update_config = update_config && not (OpamSwitch.is_external switch) in
  let comp_dir = OpamPath.Switch.root gt.root switch in
  let simulate = OpamStateConfig.(!r.dryrun) || OpamClientConfig.(!r.show) in
  if OpamGlobalState.switch_exists gt switch then
    OpamConsole.error_and_exit `Bad_arguments
      "There already is an installed switch named %s"
      (OpamSwitch.to_string switch);
  if Sys.file_exists (OpamFilename.Dir.to_string comp_dir) then
    OpamConsole.error_and_exit `Bad_arguments
      "Directory %S already exists, please choose a different name"
      (OpamFilename.Dir.to_string comp_dir);
  let gt, st =
    if not simulate then
      let gt =
        OpamSwitchAction.create_empty_switch gt ?synopsis ?repos ~invariant
          switch
      in
      let rt =
        ({ rt with repos_global = (gt :> unlocked global_state)  }
         :> unlocked repos_state)
      in
      gt, OpamSwitchState.load `Lock_write gt rt switch
    else
      let rt = (rt :> unlocked repos_state) in
      let st = OpamSwitchState.load_virtual ?repos_list:repos gt rt in
      let switch_config =
        OpamSwitchAction.gen_switch_config gt.root ?repos switch ~invariant
      in
      let st = { st with switch_invariant = invariant; switch_config } in
      let available_packages =
        lazy (OpamSwitchState.compute_available_packages gt switch switch_config
                ~pinned:OpamPackage.Set.empty
                ~opams:st.opams)
      in
      gt, { st with switch; available_packages }
  in
  match post st with
  | ret, st ->
    let st =
      if update_config && not simulate
      then OpamSwitchAction.set_current_switch gt st
      else st
    in
    OpamGlobalState.drop gt;
    ret, st
  | exception e when not simulate ->
    let () =
      try OpamStd.Exn.fatal e with e ->
        OpamStd.Exn.finalise e @@ fun () ->
        OpamConsole.error
          "Switch %s left %s installed.\n\
           To clean it, use 'opam switch remove %s'"
          (OpamConsole.colorise `underline (OpamSwitch.to_string st.switch))
          (OpamConsole.colorise `bold "partially")
          (OpamSwitch.to_string st.switch)
    in
    OpamStd.Exn.finalise e @@ fun () ->
    let gt, st =
      if OpamConsole.confirm "Switch initialisation failed: clean up? \
                              ('n' will leave the switch partially installed)"
      then clear_switch gt st.switch, st
      else if update_config && not simulate
      then gt, OpamSwitchAction.set_current_switch gt st
      else gt, st
    in
    OpamSwitchState.drop st;
    OpamGlobalState.drop gt

let switch lock gt switch =
  log "switch switch=%a" (slog OpamSwitch.to_string) switch;
  if OpamGlobalState.switch_exists gt switch then
    OpamRepositoryState.with_ `Lock_none gt @@ fun rt ->
    let st = OpamSwitchState.load lock gt rt switch in
    let st =
      if OpamStateConfig.(!r.dryrun) || OpamClientConfig.(!r.show) then st
      else OpamSwitchAction.set_current_switch gt st
    in
    OpamEnv.check_and_print_env_warning st
  else
  let installed_switches = OpamFile.Config.installed_switches gt.config in
  OpamConsole.error_and_exit `Not_found
    "No switch %s is currently installed. Did you mean \
     'opam switch create %s'?\n\
     Installed switches are:\n%s"
    (OpamSwitch.to_string switch) (OpamSwitch.to_string switch)
    (OpamStd.Format.itemize OpamSwitch.to_string installed_switches)

let switch_previous lock gt =
  match OpamFile.Config.previous_switch gt.config with
  | Some switch_name ->
    OpamConsole.msg
      (if OpamStateConfig.(!r.dryrun) || OpamClientConfig.(!r.show)
       then "Would select opam switch %s.\n"
       else "Selecting opam switch %s.\n")
      (OpamConsole.colorise `yellow (OpamSwitch.to_string switch_name));
    switch lock gt switch_name
  | None ->
    OpamConsole.error_and_exit `Not_found
      "No previously used switch could be found"

let import_t ?ask ?(deps_only=false) importfile t =
  log "import switch";

  let extra_files = importfile.OpamFile.SwitchExport.extra_files in
  let xfiles_dir =
    OpamPath.Switch.extra_files_dir t.switch_global.root t.switch
  in
  OpamHash.Map.iter (fun hash content ->
      let value = Base64.decode_exn ~pad:false content in
      let my = OpamHash.compute_from_string ~kind:(OpamHash.kind hash) value in
      if OpamHash.contents my = OpamHash.contents hash then
        let dst =
          let base = OpamFilename.Base.of_string (OpamHash.contents hash) in
          OpamFilename.create xfiles_dir base
        in
          OpamFilename.write dst value
      else
        failwith "Bad hash for inline extra-files") extra_files;

  let import_sel = importfile.OpamFile.SwitchExport.selections in
  let import_opams = importfile.OpamFile.SwitchExport.overlays in

  (* Check that pinned packages need reinstall *)
  let to_reinstall =
    OpamPackage.Name.Map.fold (fun name imported reinst ->
        try
          let pkg =
            OpamSwitchState.find_installed_package_by_name t name
          in
          let installed = OpamSwitchState.opam t pkg in
          if OpamFile.OPAM.effectively_equal
              ~modulo_state:true installed imported then
            reinst
          else OpamPackage.Set.add pkg reinst
        with Not_found -> reinst)
      import_opams OpamPackage.Set.empty
  in
  let t =
    { t with reinstall =
               lazy OpamPackage.Set.Op.(Lazy.force t.reinstall ++ to_reinstall) }
  in

  let opams =
    OpamPackage.Name.Map.fold (fun name opam opams ->
        let nv = OpamPackage.create name (OpamFile.OPAM.version opam) in
        OpamPackage.Map.add nv opam opams)
      import_opams t.opams
  in

  let packages = t.packages ++ OpamPackage.keys opams in

  let pinned =
    let names = OpamPackage.names_of_packages import_sel.sel_pinned in
    OpamPackage.Set.filter
      (fun nv -> not (OpamPackage.Name.Set.mem nv.name names)) t.pinned ++
    import_sel.sel_pinned
  in

  let available =
    OpamSwitchState.compute_available_packages
      t.switch_global t.switch t.switch_config
      ~pinned ~opams
  in

  let compiler_packages, to_install =
    if OpamPackage.Set.is_empty t.compiler_packages then
      import_sel.sel_compiler %% available,
      import_sel.sel_installed
    else
      t.compiler_packages,
      import_sel.sel_installed -- import_sel.sel_compiler
  in
  let to_install =
    if deps_only then
      to_install -- (import_sel.sel_roots -- import_sel.sel_compiler)
    else to_install
  in

  let t =
    { t with
      available_packages = lazy available;
      packages;
      compiler_packages;
      pinned;
      opams; }
  in

  let unavailable_version, unavailable =
    let available_names = OpamPackage.names_of_packages available in
    OpamPackage.Set.partition
      (fun nv -> OpamPackage.Name.Set.mem nv.name available_names)
      (to_install -- available)
  in

  if not (OpamPackage.Set.is_empty unavailable_version) then
    OpamConsole.warning
      "These packages aren't available at the specified versions, \
       version constraints have been discarded:\n%s"
      (OpamStd.Format.itemize OpamPackage.to_string
         (OpamPackage.Set.elements unavailable_version));
  if not (OpamPackage.Set.is_empty unavailable) then
    OpamConsole.warning
      "These packages are unavailable, they have been ignored from \
       the import file:\n%s"
      (OpamStd.Format.itemize OpamPackage.to_string
         (OpamPackage.Set.elements unavailable));

  let t, solution =
    let to_import =
      OpamSolution.eq_atoms_of_packages (to_install %% available) @
      OpamSolution.atoms_of_packages unavailable_version
    in

    let add_roots = OpamPackage.names_of_packages import_sel.sel_roots in

    OpamSolution.resolve_and_apply ?ask t Import
      ~requested:((to_install %% available) ++ unavailable_version)
      ~add_roots
      (OpamSolver.request ~install:to_import ())
  in
  OpamSolution.check_solution t solution;
  OpamFilename.rmdir xfiles_dir;
  if not (OpamStateConfig.(!r.dryrun) || OpamClientConfig.(!r.show))
  then begin
    (* Put imported overlays in place *)
    OpamPackage.Set.iter (fun nv ->
        match OpamPackage.Name.Map.find_opt nv.name import_opams with
        | None -> ()
        | Some opam ->
          OpamFilename.rmdir
            (OpamPath.Switch.Overlay.package t.switch_global.root
               t.switch nv.name);
          OpamFile.OPAM.write
            (OpamPath.Switch.Overlay.opam t.switch_global.root
               t.switch nv.name)
            opam)
      pinned;
    (* Save new pinnings *)
    let sel = OpamSwitchState.load_selections t.switch_global t.switch in
    S.write
      (OpamPath.Switch.selections t.switch_global.root t.switch)
      { sel with sel_pinned = pinned }
  end;
  t

let freeze_url src_dir nv url =
  let url_t = OpamFile.URL.url url in
  match url_t.backend with
  | #OpamUrl.version_control ->
    (match OpamProcess.Job.run
             (OpamRepository.revision (src_dir nv) url_t) with
    | None ->
      OpamConsole.error_and_exit `Not_found
        "Unable to retrieve %s url revision: %s, \
         it can't be exported with --freeze."
        (OpamPackage.to_string nv)
        (OpamUrl.to_string url_t)
    | Some hash ->
      OpamFile.URL.with_url
        { url_t with hash = Some (OpamPackage.Version.to_string hash) }
        url)
  | `http ->
    (match OpamFile.URL.checksum url with
     | [] ->
       OpamConsole.error_and_exit `Not_found
         "%s url doesn't have an associated checksum, \
          it can't be exported with --freeze."
         (OpamPackage.Name.to_string nv.name)
     | _ -> url)
  | `rsync ->
    OpamConsole.error_and_exit `Not_found
      "%s is path pinned, it can't be exported with --freeze."
      (OpamPackage.Name.to_string nv.name)

let freeze_opam src_dir nv opam =
  let url =
    OpamStd.Option.map
      (fun url -> freeze_url src_dir nv url)
      (OpamFile.OPAM.url opam)
  in
  let extra_sources =
    List.map
      (fun (name, url) -> (name, freeze_url src_dir nv url))
      (OpamFile.OPAM.extra_sources opam)
  in
  opam |>
  OpamFile.OPAM.with_url_opt url |>
  OpamFile.OPAM.with_extra_sources extra_sources

let export rt ?(freeze=false) ?(full=false)
    ?(switch=OpamStateConfig.get_switch ()) filename =
  let root = OpamStateConfig.(!r.root_dir) in
  let export =
    OpamFilename.with_flock `Lock_none (OpamPath.Switch.lock root switch)
    @@ fun _ ->
    let selections =
      OpamStateConfig.Switch.safe_read_selections
        ~lock_kind:`Lock_none rt.repos_global switch
    in
    let opams =
      let read_opams read pkgs =
        let src_dir nv =
          if OpamPackage.Set.mem nv selections.sel_pinned then
            OpamPath.Switch.pinned_package root switch nv.name
          else
            OpamPath.Switch.sources root switch nv
        in
        OpamPackage.Set.fold (fun nv map ->
            match read nv with
            | Some opam ->
              let opam =
                if not freeze then opam else
                  freeze_opam src_dir nv opam
              in
              OpamPackage.Map.add nv opam map
            | None -> map) pkgs OpamPackage.Map.empty
      in
      let overlays =
        read_opams (fun nv ->
            OpamFileTools.read_opam
              (OpamPath.Switch.Overlay.package root switch nv.name))
          selections.sel_pinned
      in
      if not full then overlays else
        OpamPackage.Map.union (fun a _ -> a) overlays
        @@ read_opams (fun nv -> OpamFile.OPAM.read_opt
                          (OpamPath.Switch.installed_opam root switch nv))
          (selections.sel_installed -- selections.sel_pinned)
    in
    let overlays =
      OpamPackage.Map.fold (fun nv opam nmap ->
          OpamPackage.Name.Map.add nv.name opam nmap)
        opams OpamPackage.Name.Map.empty
    in
    let extra_files =
      let repos_roots = OpamRepositoryState.get_root rt in
      OpamPackage.Map.fold (fun nv opam hmap ->
          match OpamFile.OPAM.get_extra_files ~repos_roots opam with
          | [] -> hmap
          | files ->
            let hmap, err =
              List.fold_left (fun (hmap,err) (file, base, hash) ->
                  if OpamFilename.exists file &&
                     OpamHash.check_file (OpamFilename.to_string file) hash then
                    let value = Base64.encode_string ~pad:false (OpamFilename.read file) in
                    OpamHash.Map.add hash value hmap, err
                  else hmap, base::err)
                (hmap,[]) files
            in
            if err <> [] then
              OpamConsole.warning "Invalid hash%s, ignoring package %s extra-file%s: %s"
                (match err with | [_] -> "" | _ -> "es")
                (OpamPackage.to_string nv)
                (match err with | [_] -> "" | _ -> "s")
                (OpamStd.Format.pretty_list (List.map OpamFilename.Base.to_string err));
            hmap)
        opams OpamHash.Map.empty
    in
    { OpamFile.SwitchExport.selections; extra_files; overlays }
  in
  match filename with
  | None   -> OpamFile.SwitchExport.write_to_channel stdout export
  | Some f -> OpamFile.SwitchExport.write f export

let show () =
  OpamConsole.msg "%s\n"
    (OpamSwitch.to_string (OpamStateConfig.get_switch ()))

let reinstall init_st =
  let switch = init_st.switch in
  log "reinstall switch=%a" (slog OpamSwitch.to_string) switch;
  let gt = init_st.switch_global in

  let switch_root = OpamPath.Switch.root gt.root switch in
  let opam_subdir = OpamPath.Switch.meta gt.root switch in
  let pkg_dirs =
    List.filter ((<>) opam_subdir) (OpamFilename.dirs switch_root)
  in
  List.iter OpamFilename.cleandir pkg_dirs;
  List.iter OpamFilename.remove (OpamFilename.files switch_root);
  OpamFilename.cleandir (OpamPath.Switch.config_dir gt.root switch);
  OpamFilename.cleandir (OpamPath.Switch.installed_opams gt.root switch);
  let st =
    { init_st with
      installed = OpamPackage.Set.empty;
      installed_roots = OpamPackage.Set.empty;
      reinstall = lazy OpamPackage.Set.empty; }
  in
  import_t { OpamFile.SwitchExport.
             selections = OpamSwitchState.selections init_st;
             extra_files = OpamHash.Map.empty;
             overlays = OpamPackage.Name.Map.empty; }
    st

let import st ?deps_only filename =
  let import_str = match filename with
    | None   -> OpamSystem.string_of_channel stdin
    | Some f -> OpamFilename.read (OpamFile.filename f)
  in
  let importfile =
    try OpamFile.SwitchExport.read_from_string ?filename import_str
    with OpamPp.Bad_format _ as e ->
      log "Error loading export file, trying the old file format";
      try
        let selections = OpamFile.LegacyState.read_from_string import_str in
        { OpamFile.SwitchExport.selections;
          extra_files = OpamHash.Map.empty;
          overlays = OpamPackage.Name.Map.empty }
      with e1 -> OpamStd.Exn.fatal e1; raise e
  in
  import_t ?deps_only importfile st

let set_invariant ?(force=false) st invariant =
  let satisfied = OpamFormula.satisfies_depends st.installed invariant in
  let names =
    OpamPackage.Name.Set.of_list (List.map fst (OpamFormula.atoms invariant))
  in
  let name_unknown =
    OpamPackage.Name.Set.filter
      (fun n -> not (OpamPackage.has_name st.packages n))
      names
  in
  if not (OpamPackage.Name.Set.is_empty name_unknown) then
    (if satisfied || force then OpamConsole.warning
     else OpamConsole.error_and_exit `Not_found)
      "No packages by these names found: %s"
      (OpamStd.List.concat_map ", "
         OpamPackage.Name.to_string
         (OpamPackage.Name.Set.elements name_unknown));
  set_invariant_raw st invariant

let get_compiler_packages ?repos rt =
  let repos = match repos with
    | None -> OpamGlobalState.repos_list rt.repos_global
    | Some r -> r
  in
  let package_index = OpamRepositoryState.build_index rt repos in
  OpamPackage.Map.filter
    (fun _ opam ->
       OpamFile.OPAM.has_flag Pkgflag_Compiler opam &&
       OpamFilter.eval_to_bool ~default:false
         (OpamPackageVar.resolve_global rt.repos_global)
         (OpamFile.OPAM.available opam))
    package_index
  |> OpamPackage.keys

let guess_compiler_invariant ?repos rt strings =
  let repos = match repos with
    | None -> OpamGlobalState.repos_list rt.repos_global
    | Some r -> r
  in
  let opams = OpamRepositoryState.build_index rt repos  in
  let packages = OpamPackage.keys opams in
  let compiler_packages =
    OpamPackage.Map.filter
      (fun _ -> OpamFile.OPAM.has_flag Pkgflag_Compiler)
      opams
    |> OpamPackage.keys
  in
  let invariant =
    List.fold_left (fun acc str ->
        try
          let (name, _) as atom = OpamFormula.atom_of_string str in
          if OpamPackage.Set.exists (OpamFormula.check atom)
              (OpamPackage.packages_of_name packages name)
          then OpamFormula.ands [acc; Atom atom]
          else raise Not_found
        with Failure _ | Not_found ->
        try
          let v = OpamPackage.Version.of_string str in
          let candidates =
            OpamPackage.Set.filter (fun nv -> nv.version = v)
              compiler_packages
          in
          if OpamPackage.Set.is_empty candidates then
            raise Not_found
          else
          let disj =
            OpamPackage.Set.fold
              (fun nv acc ->
                 OpamFormula.ors
                   [acc; Atom (OpamSolution.eq_atom_of_package nv)])
              candidates OpamFormula.Empty
          in
          OpamFormula.ands [acc; disj]
        with
        | Failure _ ->
          OpamConsole.error_and_exit `Bad_arguments
            "Invalid package specification or version %S"
            str
        | Not_found ->
          OpamConsole.error_and_exit `Not_found
            "No compiler matching `%s' found, use `opam switch list-available' \
             to see what is available, or use `--packages' to select packages \
             explicitly."
            str)
      OpamFormula.Empty
      strings
  in
  OpamFormula.of_atom_formula invariant
OCaml

Innovation. Community. Security.