Encode the opam file format to JSON

opam2json.ml

(*---------------------------------------------------------------------------
   Copyright (c) 2025 The opam programmers. All rights reserved.
   SPDX-License-Identifier: LGPL-2.1-only WITH OCaml-LGPL-linking-exception
  ---------------------------------------------------------------------------*)

(* Usage: opam2json < opam
          opam switch export - | opam2json
   Compile with:
   ocamlfind ocamlopt -linkpkg -package opam-core,opam-format \
   opam2json.ml -o opam2json *)

open OpamParserTypes.FullPos

module Json_number = struct
  let number_contains_int = Sys.int_size <= 53
  let min_exact_int = if number_contains_int then Int.min_int else -(1 lsl 53)
  let max_exact_int = if number_contains_int then Int.max_int else 1 lsl 53
  let can_store_exact_int v = min_exact_int <= v && v <= max_exact_int
end

let rec value_to_json : value -> OpamJson.t =
  (* N.B. Not using cases for operators makes it more readable but likely
     more painful to parse back to a proper data structure. If readable
     output is not the use case, it should be changed. If readable output
     is, aswell :-) *)
  fun value ->
  let case ?(more = []) kind ~value =
    `O (("kind",`String kind) :: ("value", value) :: more)
  in
  match value.pelem with
  | Bool b -> `Bool b
  | Int n when Json_number.can_store_exact_int n -> `Float (Float.of_int n)
  | Int n -> `String (Printf.sprintf "%d" n)
  | String s -> `String s
  | Ident id -> case "ident" ~value:(`String id)
  | List l -> `A (List.map value_to_json l.pelem)
  | Group l -> case "group" ~value:(`A (List.map value_to_json l.pelem))
  | Option (v, l) ->
      let more = ["list", `A (List.map value_to_json l.pelem) ] in
      case "option" ~value:(value_to_json v) ~more
  | Env_binding (l, op, r) ->
      `A [value_to_json l;
          `String (OpamPrinter.FullPos.env_update_op_kind op.pelem);
          value_to_json r]
  | Relop (op, l, r) ->
      `A [value_to_json l;
          `String (OpamPrinter.FullPos.relop_kind op.pelem);
          value_to_json r]
  | Prefix_relop (op, v) ->
      `A [`String (OpamPrinter.FullPos.relop_kind op.pelem);
          value_to_json v]
  | Logop (op, l, r) ->
      `A [value_to_json l;
          `String (OpamPrinter.FullPos.logop_kind op.pelem);
          value_to_json r]
  | Pfxop (op, v) ->
      `A [`String (OpamPrinter.FullPos.pfxop_kind op.pelem);
          value_to_json v]

let rec opamfile_items_to_json : opamfile_item list -> OpamJson.t =
  (* At each level we have vars and (possibly unnamed) sections of a given kind.
     We turn section kind names into a member name that holds an object whose
     fields names are a) the named sections mapping to an object with their
     content b) the variable names of unamed sections. *)
  fun items ->
    let rec loop vars by_section_kind = function
    | { pelem = Section s; } :: items ->
        let kind = s.section_kind.pelem in
        let obj = opamfile_items_to_json s.section_items.pelem in
        let by_section_kind = match s.section_name with
        | None ->
            (* We splice the names directly in the section kind. A bit unclear if
               this is the right thing to do. It could override vars if there's
               multiple unnamed section with identical variables. *)
            let mems = match obj with `O mems -> mems | _ -> assert false in
            let mems =
              match OpamStd.String.Map.find_opt kind by_section_kind with
              | None -> mems
              | Some acc -> List.rev_append mems acc
            in
            OpamStd.String.Map.add kind mems by_section_kind
        | Some { pelem = name } ->
            (* There will be non-interoperable JSON dupes if section names are
               not unique *)
            OpamStd.String.Map.add_to_list kind (name, obj) by_section_kind
        in
        loop vars by_section_kind items
    | { pelem = Variable (name, value) } :: items ->
        loop ((name.pelem, value_to_json value) :: vars) by_section_kind items
    | [] ->
        let add_section sec mems acc = (sec, (`O mems)) :: acc in
        OpamStd.String.Map.fold add_section by_section_kind vars
    in
  `O (Stdlib.List.sort compare (loop [] OpamStd.String.Map.empty items))

let opamfile_to_json : opamfile -> OpamJson.t =
fun file -> opamfile_items_to_json file.file_contents

(* Command line interface *)

let main () =
  let res = match In_channel.input_all In_channel.stdin with
  | exception Sys_error e -> Error e
  | stdin ->
      match OpamParser.FullPos.string stdin "-" with
      | exception exn (* ? no docs on how it errors *) ->
          Error (Printexc.to_string exn)
      | opamfile ->
          let json = opamfile_to_json opamfile in
          let json = OpamJson.to_string json in
          Ok (print_endline json)
  in
  match res with
  | Error e -> Printf.eprintf "Error: %s\n%!" e; 1
  | Ok () -> 0


let () = if !Stdlib.Sys.interactive then () else exit (main ())