Source file opamcudf.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
(**************************************************************************************)
(*  Copyright (C) 2015 Pietro Abate <pietro.abate@pps.jussieu.fr>                     *)
(*  Copyright (C) 2015 Mancoosi Project                                               *)
(*                                                                                    *)
(*  This library is free software: you can redistribute it and/or modify              *)
(*  it under the terms of the GNU Lesser General Public License as                    *)
(*  published by the Free Software Foundation, either version 3 of the                *)
(*  License, or (at your option) any later version.  A special linking                *)
(*  exception to the GNU Lesser General Public License applies to this                *)
(*  library, see the COPYING file for more information.                               *)
(**************************************************************************************)

(** Opam/Pef format conversion routines *)

open ExtLib
open Dose_common

include Util.Logging (struct
  let label = "dose_opam.opamcudf"
end)

type options =
  { switch : string;
    (* the active switch *)
    switches : string list;
    (* list of available switches *)
    profiles : string list;
    (* list of build profiles *)
    depopts : bool (* add depopts as hard dependencies *)
  }

let default_options =
  { switch = ""; switches = []; profiles = []; depopts = false }

let preamble =
  let l =
    [ ("depopts", `Vpkgformula (Some []));
      ("number", `String None);
      ("active", `Int None);
      ("version-lag", `Nat (Some 0));
      ("switch", `String None) ]
  in
  CudfAdd.add_properties Cudf.default_preamble l

(* version-lag is the distance from the most recent package *)
let add_extra extras tables (switch, activeswitch) pkg =
  let number = ("number", `String pkg#version) in
  let switchprop = ("switch", `String switch) in
  let activeswitch =
    let n = if switch = activeswitch then 1 else 0 in
    ("active", `Int n)
  in
  let version_lag =
    let l = Hashtbl.find tables.Dose_pef.Pefcudf.versions_table pkg#name in
    let (count, i) =
      List.fold_left
        (fun (i, r) v -> if v = pkg#version then (i, i) else (i + 1, r))
        (0, 0)
        l
    in
    ("version-lag", `Int (count - i))
  in
  let l =
    List.filter_map
      (fun (debprop, (cudfprop, v)) ->
        let debprop = String.lowercase debprop in
        let cudfprop = String.lowercase cudfprop in
        try
          let s = List.assoc debprop pkg#extras in
          let typ = Cudf_types.type_of_typedecl v in
          try Some (cudfprop, Cudf_types_pp.parse_value typ s)
          with Cudf_types_pp.Type_error _ ->
            fatal
              "Cudf Parsing Error while converting properties %s: %s"
              debprop
              s
        with Not_found -> None)
      extras
  in
  let depopts =
    ("depopts", `Vpkgformula (Dose_pef.Pefcudf.loadll tables pkg#depopts))
  in
  List.filter_map
    (function
      | (_, `Vpkglist []) -> None | (_, `Vpkgformula []) -> None | e -> Some e)
    [switchprop; number; depopts; activeswitch; version_lag]
  @ l

let decode name =
  let extract_name x =
    try String.sub x 0 (String.index x ':') with Not_found -> x
  in
  CudfAdd.decode (extract_name name)

(* each package generates more than one cudf package. One for active switch
   that is not declaclare not available by the package . Each package is
   translated differently considering the profiles associated to each dependency *)
let tocudf tables ?(options = default_options) ?(extras = []) pkg =
  let all_switches = List.unique (options.switch :: options.switches) in
  if options.switch = "" then
    warning "Now default switch specified in opam -> cudf conversion" ;
  List.fold_left
    (fun acc switch ->
      (* include this package if it is not declared as not available and if it is
       * used in some dependency. Otherwise there is no point to include it *)
      if List.mem "all" pkg#switch || List.mem switch pkg#switch then
        let depends =
          if options.depopts then pkg#depends @ pkg#depopts else pkg#depends
        in
        let keep =
          if List.mem switch pkg#baselist then `Keep_package
          else if List.mem switch pkg#pinnedlist then `Keep_version
          else `Keep_none
        in
        let cudfpkg =
          { Cudf.default_package with
            Cudf.package = CudfAdd.encode (pkg#name ^ ":" ^ switch);
            version =
              Dose_pef.Pefcudf.get_cudf_version tables (pkg#name, pkg#version);
            installed = List.mem switch pkg#installedlist;
            keep;
            depends =
              Dose_pef.Pefcudf.loadll
                tables
                ~arch:switch
                ~archs:all_switches
                depends;
            conflicts =
              Dose_pef.Pefcudf.loadlc
                tables
                ~arch:switch
                ~archs:all_switches
                pkg#conflicts;
            provides =
              Dose_pef.Pefcudf.loadlp
                tables
                ~arch:switch
                ~archs:all_switches
                pkg#provides;
            pkg_extra = add_extra extras tables (switch, options.switch) pkg
          }
        in
        cudfpkg :: acc
      else acc)
    []
    all_switches

(* convert an opam vpkg list into a cudf vpkg list *)
let encode_vpkglist tables switch vpkglist =
  let to_cudf (p, v) = (p, Dose_pef.Pefcudf.get_cudf_version tables (p, v)) in
  List.map
    (fun (vpkgname, constr) ->
      let vpkgname =
        match vpkgname with (n, None) -> (n, Some switch) | _ -> vpkgname
      in
      Dose_pef.Pefcudf.pefvpkg to_cudf (vpkgname, constr))
    vpkglist

(** convert a opam request to a cudf request *)
let requesttocudf tables universe request =
  let remove = List.map (fun (n, _) -> (n, None)) in
  let switch = request.Packages.switch in
  if request.Packages.dist_upgrade then
    let to_upgrade = function
      | [] ->
          let filter pkg = pkg.Cudf.installed in
          let l = Cudf.get_packages ~filter universe in
          List.map (fun pkg -> (pkg.Cudf.package, None)) l
      | l -> encode_vpkglist tables switch l
    in
    { Cudf.default_request with
      Cudf.request_id = "Opam";
      Cudf.upgrade = to_upgrade request.Packages.install;
      Cudf.remove =
        remove (encode_vpkglist tables switch request.Packages.remove)
    }
  else
    { Cudf.default_request with
      Cudf.request_id = "Opam";
      Cudf.install = encode_vpkglist tables switch request.Packages.install;
      Cudf.remove =
        remove (encode_vpkglist tables switch request.Packages.remove);
      Cudf.upgrade = encode_vpkglist tables switch request.Packages.upgrade
    }

let load_list ?(options = default_options) compare l =
  let timer = Util.Timer.create "Opam.ToCudf" in
  Util.Timer.start timer ;
  let tables = Dose_pef.Pefcudf.init_tables compare l in
  let pkglist = List.flatten (List.map (tocudf ~options tables) l) in
  Dose_pef.Pefcudf.clear tables ;
  Util.Timer.stop timer pkglist

let load_universe ?(options = default_options) compare l =
  let pkglist = load_list ~options compare l in
  let timer = Util.Timer.create "Opam.ToCudf" in
  Util.Timer.start timer ;
  let univ = Cudf.load_universe pkglist in
  Util.Timer.stop timer univ