Utils.ml

(**
 * `startsWith(string, prefix)`
 * true if the string starts with the prefix
 *)
let startsWith s prefix =
  if prefix = "" then true
  else
    let p = String.length prefix in
    p <= String.length s && String.sub s 0 p = prefix

let endsWith s suffix =
  if suffix = "" then true
  else
    let p = String.length suffix in
    let l = String.length s in
    p <= String.length s && String.sub s (l - p) p = suffix

let cmtPosToPosition {Lexing.pos_lnum; pos_cnum; pos_bol} =
  Protocol.{line = pos_lnum - 1; character = pos_cnum - pos_bol}

let cmtLocToRange {Location.loc_start; loc_end} =
  Protocol.{start = cmtPosToPosition loc_start; end_ = cmtPosToPosition loc_end}

let endOfLocation loc length =
  let open Location in
  {
    loc with
    loc_start = {loc.loc_end with pos_cnum = loc.loc_end.pos_cnum - length};
  }

let chopLocationEnd loc length =
  let open Location in
  {
    loc with
    loc_end = {loc.loc_end with pos_cnum = loc.loc_end.pos_cnum - length};
  }

(** An optional List.find *)
let rec find fn items =
  match items with
  | [] -> None
  | one :: rest -> (
    match fn one with
    | None -> find fn rest
    | Some x -> Some x)

let filterMap f =
  let rec aux accu = function
    | [] -> List.rev accu
    | x :: l -> (
      match f x with
      | None -> aux accu l
      | Some v -> aux (v :: accu) l)
  in
  aux []

let dumpPath path = Str.global_replace (Str.regexp_string "\\") "/" path
let isUncurriedInternal path = startsWith (Path.name path) "Js.Fn.arity"

let flattenLongIdent ?(jsx = false) ?(cutAtOffset = None) lid =
  let extendPath s path =
    match path with
    | "" :: _ -> path
    | _ -> s :: path
  in
  let rec loop lid =
    match lid with
    | Longident.Lident txt -> ([txt], String.length txt)
    | Ldot (lid, txt) ->
      let path, offset = loop lid in
      if Some offset = cutAtOffset then (extendPath "" path, offset + 1)
      else if jsx && txt = "createElement" then (path, offset)
      else if txt = "_" then (extendPath "" path, offset + 1)
      else (extendPath txt path, offset + 1 + String.length txt)
    | Lapply _ -> ([], 0)
  in
  let path, _ = loop lid in
  List.rev path

let identifyPexp pexp =
  match pexp with
  | Parsetree.Pexp_ident _ -> "Pexp_ident"
  | Pexp_constant _ -> "Pexp_constant"
  | Pexp_let _ -> "Pexp_let"
  | Pexp_function _ -> "Pexp_function"
  | Pexp_fun _ -> "Pexp_fun"
  | Pexp_apply _ -> "Pexp_apply"
  | Pexp_match _ -> "Pexp_match"
  | Pexp_try _ -> "Pexp_try"
  | Pexp_tuple _ -> "Pexp_tuple"
  | Pexp_construct _ -> "Pexp_construct"
  | Pexp_variant _ -> "Pexp_variant"
  | Pexp_record _ -> "Pexp_record"
  | Pexp_field _ -> "Pexp_field"
  | Pexp_setfield _ -> "Pexp_setfield"
  | Pexp_array _ -> "Pexp_array"
  | Pexp_ifthenelse _ -> "Pexp_ifthenelse"
  | Pexp_sequence _ -> "Pexp_sequence"
  | Pexp_while _ -> "Pexp_while"
  | Pexp_for _ -> "Pexp_for"
  | Pexp_constraint _ -> "Pexp_constraint"
  | Pexp_coerce _ -> "Pexp_coerce"
  | Pexp_send _ -> "Pexp_send"
  | Pexp_new _ -> "Pexp_new"
  | Pexp_setinstvar _ -> "Pexp_setinstvar"
  | Pexp_override _ -> "Pexp_override"
  | Pexp_letmodule _ -> "Pexp_letmodule"
  | Pexp_letexception _ -> "Pexp_letexception"
  | Pexp_assert _ -> "Pexp_assert"
  | Pexp_lazy _ -> "Pexp_lazy"
  | Pexp_poly _ -> "Pexp_poly"
  | Pexp_object _ -> "Pexp_object"
  | Pexp_newtype _ -> "Pexp_newtype"
  | Pexp_pack _ -> "Pexp_pack"
  | Pexp_extension _ -> "Pexp_extension"
  | Pexp_open _ -> "Pexp_open"
  | Pexp_unreachable -> "Pexp_unreachable"

let identifyPpat pat =
  match pat with
  | Parsetree.Ppat_any -> "Ppat_any"
  | Ppat_var _ -> "Ppat_var"
  | Ppat_alias _ -> "Ppat_alias"
  | Ppat_constant _ -> "Ppat_constant"
  | Ppat_interval _ -> "Ppat_interval"
  | Ppat_tuple _ -> "Ppat_tuple"
  | Ppat_construct _ -> "Ppat_construct"
  | Ppat_variant _ -> "Ppat_variant"
  | Ppat_record _ -> "Ppat_record"
  | Ppat_array _ -> "Ppat_array"
  | Ppat_or _ -> "Ppat_or"
  | Ppat_constraint _ -> "Ppat_constraint"
  | Ppat_type _ -> "Ppat_type"
  | Ppat_lazy _ -> "Ppat_lazy"
  | Ppat_unpack _ -> "Ppat_unpack"
  | Ppat_exception _ -> "Ppat_exception"
  | Ppat_extension _ -> "Ppat_extension"
  | Ppat_open _ -> "Ppat_open"

let identifyType type_desc =
  match type_desc with
  | Types.Tvar _ -> "Tvar"
  | Tarrow _ -> "Tarrow"
  | Ttuple _ -> "Ttuple"
  | Tconstr _ -> "Tconstr"
  | Tobject _ -> "Tobject"
  | Tfield _ -> "Tfield"
  | Tnil -> "Tnil"
  | Tlink _ -> "Tlink"
  | Tsubst _ -> "Tsubst"
  | Tvariant _ -> "Tvariant"
  | Tunivar _ -> "Tunivar"
  | Tpoly _ -> "Tpoly"
  | Tpackage _ -> "Tpackage"

let rec skipWhite text i =
  if i < 0 then 0
  else
    match text.[i] with
    | ' ' | '\n' | '\r' | '\t' -> skipWhite text (i - 1)
    | _ -> i

let hasBraces attributes =
  attributes |> List.exists (fun (loc, _) -> loc.Location.txt = "ns.braces")

let rec unwrapIfOption (t : Types.type_expr) =
  match t.desc with
  | Tlink t1 | Tsubst t1 | Tpoly (t1, []) -> unwrapIfOption t1
  | Tconstr (Path.Pident {name = "option"}, [unwrappedType], _) -> unwrappedType
  | _ -> t
let isReactComponent (vb : Parsetree.value_binding) =
  vb.pvb_attributes
  |> List.exists (function
       | {Location.txt = "react.component"}, _payload -> true
       | _ -> false)

let checkName name ~prefix ~exact =
  if exact then name = prefix else startsWith name prefix

let rec getUnqualifiedName txt =
  match txt with
  | Longident.Lident fieldName -> fieldName
  | Ldot (t, _) -> getUnqualifiedName t
  | _ -> ""

let indent n text =
  let spaces = String.make n ' ' in
  let len = String.length text in
  let text =
    if len != 0 && text.[len - 1] = '\n' then String.sub text 0 (len - 1)
    else text
  in
  let lines = String.split_on_char '\n' text in
  match lines with
  | [] -> ""
  | [line] -> line
  | line :: lines ->
    line ^ "\n"
    ^ (lines |> List.map (fun line -> spaces ^ line) |> String.concat "\n")

let mkPosition (pos : Pos.t) =
  let line, character = pos in
  {Protocol.line; character}

let rangeOfLoc (loc : Location.t) =
  let start = loc |> Loc.start |> mkPosition in
  let end_ = loc |> Loc.end_ |> mkPosition in
  {Protocol.start; end_}