open Common
open Either

open Web

(*****************************************************************************)
(* Types  *)
(*****************************************************************************)

(* Yet another Parse_info.token_location, 
 * but I don't want to depend on pfff/h_program-lang
 * (I do depend on it for syncweb/indexer/ but I don't want for syncweb itself).
 *)
type loc = { 
  file: string (* Common.filename *);
  line: int;
}
(* Yet another Entity_code.t,
 * but I don't want to depend on pfff/h_program-lang *)
type entity_kind =
  | Function
  (* less: FunctionPrivate *)
  | Global
  (* less: GlobalPrivate *)

  | Constant
  | Macro
  | Constructor

  | Type
  | Field

  | Typedef
  | Structdef

  | Exception

  | Other of string

type defs = ((string * entity_kind) * loc) list
type uses = ((string * entity_kind) * loc) list

let debug = ref false

let string_of_loc { file; line } =
  spf "%s:%d" file line
  
(*****************************************************************************)
(* Parsing  *)
(*****************************************************************************)

(* mostly copy-paste of Entity_code.entity_kind_of_string *)
let kind_of_string_opt = function
  | "Function" -> Some Function
  | "Global" -> Some Global

  | "Constant" -> Some Constant
  | "Macro" -> Some Macro
  | "Constructor" -> Some Constructor

  | "Type" -> Some Type
  | "Field" -> Some Field

  | "Exception" -> Some Exception

  | "Prototype" 
  | "GlobalExtern"

  | "Module"
  | "TopStmts"

    -> None
  | s -> failwith (spf "unsupported kind: %s" s)
(*
  | "Class" -> Some Class
  | "Method" -> Some Method
  | "ClassConstant" -> Some ClassConstant
  | "File" -> Some File
  | "Dir" -> Some Dir
  | "MultiDirs" -> Some MultiDirs

  | _ when s =~ "Other:\\(.*\\)" -> Other (Common.matched1 s)
  | s -> None
*)


let adjust_name_and_kind s kind =
  match s, kind with
  (* graph_code_c adds some '__<int>' suffix for static functions *)
  | _ when s =~ "^\\(.*\\)__[0-9]+$" ->
    Common.matched1 s ^ "<>", kind
  (* graph_code_c adds some 'S__' prefix to manage namespaces *)
  | _, Type when s =~ "^[SU]__\\(.*\\)$" ->
    Common.matched1 s, Structdef
  | _, Field when s =~ "^[SU]__\\(.*\\)$" ->
    Common.matched1 s, Field
  | _, Type when s =~ "^[T]__\\(.*\\)$" ->
    Common.matched1 s, Typedef
  | _, Type when s =~ "^[E]__\\(.*\\)$" ->
    Common.matched1 s, Type
  | _ -> 
    s, kind


(* the data is generated by ../indexer/index_pfff.ml *)
let parse_defs_and_uses file =
  let defs = ref [] in
  let uses = ref [] in
  UFile.Legacy.cat file |> List.iter (fun s ->
    let xs = Str.split_delim (Str.regexp ":") s in
    match xs with
    | ["DEF";kind_str;file;line;name] ->
      let kind_opt = kind_of_string_opt kind_str in
      kind_opt |> Option.iter (fun kind ->
        defs |> Stack_.push (adjust_name_and_kind name kind,
                           {file = file ;line = int_of_string line})
      )
    | ["USE";kind_str;file;line;name] ->
      let kind_opt = kind_of_string_opt kind_str in
      kind_opt |> Option.iter (fun kind ->
        uses |> Stack_.push (adjust_name_and_kind name kind, 
                           {file = file;line = int_of_string line})
      )
    | _ -> failwith (spf "unrecognized line in defs and uses file: %s" s)
  );
  !defs, !uses

(*****************************************************************************)
(* Chunkid <-> loc list  *)
(*****************************************************************************)

(*****************************************************************************)
(* Chunkid -> defs * uses and Def -> Chunkid  *)
(*****************************************************************************)
let hs__from_orig orig (defs, uses) =
  let hchunkname_to_defs = Crossref_chunk.hchunkname_to_defs__from_orig orig in

  let hdefs_and_uses_of_chunkid = Hashtbl.create 101 in
  let hchunkid_of_def = Hashtbl.create 101 in

  (* step1: get the list of files mentioned in defs and uses, so we know
   * all the toplevel file chunks
   *)
  let files =
    ((defs |> List.map (fun ((_, _), x) -> x.file))@
     (uses |> List.map (fun ((_, _), x) -> x.file))) |> Common2.uniq
  in

  (* step2: tangle the toplevel file chunks (e.g., mk/main.c) while
   * remembering which LOC correspond to which chunkid
   *)
  (* use Hashtbl.find_all property *)
  let hchunkid_to_locs = Hashtbl.create 101 in
  files |> List.iter (fun file ->
    let loc = ref 1 in
    (* similar to web_to_code.ml *)
    if Hashtbl.find_all hchunkname_to_defs file =*= []
    then failwith (spf "could not find defs for file %s" file);
    let rec aux key =
      let defs = Hashtbl.find_all hchunkname_to_defs key |> List.rev in
      incr loc (* the s: *);
      defs |> List.iter (fun (def, body) -> 
        (* this assumes you are using -less_marks *)
        let id = def.chunkdef_id in
        body |> List.iter (function
          | Code _ -> 
            Hashtbl.add hchunkid_to_locs id ({ file; line = !loc});
            if !debug 
            then UCommon.pr (spf "id = %d (name = %s), loc = %s:%d"
                       id key file !loc);
            incr loc
          | ChunkName (key, _indent) ->
            aux key
        );
      incr loc (* the e: or x: *)
      );
    in
    aux file
  );

  (* step3: create hashtbl to go from file x LOC to defs and uses *)
  let hloc_to_defs_uses = 
    ((defs |> List.map (fun ((a, b), loc) -> loc, Left ((a, b), loc))) @
     (uses |> List.map (fun ((a, b), loc) -> loc, Right ((a, b), loc)))
    ) 
    (* bugfix: do not use '|> Common.hash_of_list' because it uses 
     * Hashtbl.replace and we want Hashtbl.add (so that later we can 
     * use Hashtbl.find_all). Indeed, the same LOC can contain multiple uses
     *)
    |> (fun xs ->
      let h = Hashtbl.create 101 in
      xs |> List.iter (fun (k, v) -> Hashtbl.add h k v);
      h
    )
  in

  (* step4: iterate over all LOC for a chunkid and accumulate the defs
   * and uses there.
   * bugfix: use Common2.hkeys not Hashtbl.iter, otherwise will get
   * get defs multiple time for each loc of id.
   *)
  hchunkid_to_locs |> Common2.hkeys |> List.iter (fun id ->
    let locs = Hashtbl.find_all hchunkid_to_locs id in
    let defs_uses = 
      locs |> List_.map_filter (fun loc ->
        try 
          (* bugfix: use Hashtbl.find_all, cos the same LOC can contain
           * multiple uses
           *)
          Some (Hashtbl.find_all hloc_to_defs_uses loc)
        with Not_found -> None
      ) |> List.flatten
    in
    let defs, uses = Either_.partition_either (fun x -> x) defs_uses in
    Hashtbl.add hdefs_and_uses_of_chunkid id (defs, uses);
    defs |> List.iter (fun ((s, kind), loc) ->
      let s =
        (* adjust_name adds this suffix for some static functions *)
        if s =~ "\\(.*\\)<>$"
        then Common.matched1 s
        else s
      in
      (* UGLY skip those for now, to avoid some ambiguity *)
      if kind <> Typedef
      then 
        Hashtbl.add hchunkid_of_def s ((kind, loc), id)
    )
  );
  
  (* step5: adjust with adhoc definitions and uses found in .nw file *)
  let last_chunkid = ref 0 in
  let fake_loc = { file = "ADHOC DEF; no source file"; line = -1 } in
  orig |> List.iter (function
    | ChunkDef ({chunkdef_id = id; _ }, _) ->
      last_chunkid := id
    | Tex xs ->
      xs |> List.iter (fun s ->
        match s with
        | _ when s =~ "\\\\swdefs{\\(.*\\)}" ->
          let str = Common.matched1 s in
          let defs = Str.split (Str.regexp " *, *") str in
          defs |> List.iter (fun adhoc_def ->
            Hashtbl.add hchunkid_of_def adhoc_def 
              ((Other "ADHOC DEF", fake_loc), !last_chunkid)
          )
        | _ -> ()
      )
  );

  hdefs_and_uses_of_chunkid,
  hchunkid_of_def

let hdefs_and_uses_of_chunkid__from_orig orig (defs, uses) =
  hs__from_orig orig (defs, uses) |> fst

let hchunkid_of_def__from_orig orig defs =
  hs__from_orig orig (defs, []) |> snd
