Source file CodeptSig.ml

open MlFront_Core

let parse_sig lexbuf =
  try Schematic.Ext.strict Schema.namespace @@ Sparser.main Slex.main lexbuf
  with Sparser.Error -> Error Unknown_format

let parse_signature text =
  let lexbuf = Lexing.from_string text in
  parse_sig lexbuf

let parse_signature_file file =
  let chan = open_in (Fpath.to_string file) in
  Fun.protect
    ~finally:(fun () -> close_in_noerr chan)
    (fun () ->
      let lexbuf = Lexing.from_channel chan in
      parse_sig lexbuf)

(* The structure of [scan_*] is the same as [Module.spirit_away] in [module.ml] *)
let rec scan_dict ?(parent_package_id : PackageId.t option) (dict : Module.dict)
    : (string * PackageId.t) list =
  Name.Map.bindings dict
  |> List.map (fun (name, value) ->
         let package_id_opt =
           match parent_package_id with
           | Some parent -> Some (PackageId.create_child parent name)
           | None -> PackageId.parse name
         in
         match package_id_opt with
         | None -> []
         | Some package_id ->
             let others =
               match value with
               | Module.Alias _ | Module.Abstract _
               | Module.Fun (_, _)
               | Module.Link _ ->
                   []
               | Module.Sig { signature; _ } -> scan_sign package_id signature
               | Module.Namespace dict' ->
                   scan_dict ~parent_package_id:package_id dict'
             in

             (name, package_id) :: others)
  |> List.flatten

and scan_sign package_id = function
  | Blank -> []
  | Divergence d -> scan_sign package_id d.before @ scan_def package_id d.after
  | Exact def -> scan_def package_id def

and scan_def package_id = function
  | { modules; _ } -> scan_dict ~parent_package_id:package_id modules

let get_modulename_packageid_pairs dict = scan_dict dict

let raise_schematic_error e =
  let msg =
    match e with
    | Schematic.Ext.Future_version _ -> "Future version of signature"
    | Schematic.Ext.Mismatched_kind _ -> "Mismatched kind of signature"
    | Schematic.Ext.Unknown_format -> "Unknown signature format"
    | Schematic.Ext.Parse_error -> "Error parsing signature"
  in
  raise (MlFront_Errors.Errors.Errored (Some msg))