GenTypeCommon.ml

module StringMap = Map.Make (String)
module StringSet = Set.Make (String)
module Config = GenTypeConfig

let logNotImplemented x =
  if !Debug.notImplemented then Log_.item "Not Implemented: %s\n" x

type optional = Mandatory | Optional
type mutable_ = Immutable | Mutable

type labelJS =
  | BoolLabel of bool
  | FloatLabel of string
  | IntLabel of string
  | StringLabel of string

type case = { label : string; labelJS : labelJS }

let isJSSafePropertyName name =
  name = ""
  || (match name.[0] with 'A' .. 'z' -> true | _ -> false)
     && name
        |> String.for_all (function
             | 'A' .. 'z' | '0' .. '9' -> true
             | _ -> false)

let labelJSToString ?(alwaysQuotes = false) case =
  let addQuotes x =
    match alwaysQuotes with true -> x |> EmitText.quotes | false -> x
  in
  let isNumber s =
    let len = String.length s in
    len > 0
    && (match len > 1 with true -> s.[0] > '0' | false -> true)
    &&
    let res = ref true in
    for i = 0 to len - 1 do
      match s.[i] with '0' .. '9' -> () | _ -> res := false
    done;
    res.contents
  in
  match case.labelJS with
  | BoolLabel b -> b |> string_of_bool |> addQuotes
  | FloatLabel s -> s |> addQuotes
  | IntLabel i -> i |> addQuotes
  | StringLabel s ->
      if s = case.label && isNumber s then s |> addQuotes
      else s |> EmitText.quotes

type closedFlag = Open | Closed

type type_ =
  | Array of type_ * mutable_
  | Function of function_
  | GroupOfLabeledArgs of fields
  | Ident of ident
  | Null of type_
  | Nullable of type_
  | Object of closedFlag * fields
  | Option of type_
  | Promise of type_
  | Record of fields
  | Tuple of type_ list
  | TypeVar of string
  | Variant of variant

and fields = field list
and argType = { aName : string; aType : type_ }

and field = {
  mutable_ : mutable_;
  nameJS : string;
  nameRE : string;
  optional : optional;
  type_ : type_;
}

and function_ = {
  argTypes : argType list;
  componentName : string option;
  retType : type_;
  typeVars : string list;
  uncurried : bool;
}

and ident = { builtin : bool; name : string; typeArgs : type_ list }

and variant = {
  bsStringOrInt : bool;
  hash : int;
  inherits : type_ list;
  noPayloads : case list;
  payloads : payload list;
  polymorphic : bool;
  unboxed : bool;
}

and payload = { case : case; inlineRecord : bool; numArgs : int; t : type_ }

let typeIsObject type_ =
  match type_ with
  | Array _ -> true
  | Function _ -> false
  | GroupOfLabeledArgs _ -> false
  | Ident _ -> false
  | Null _ -> false
  | Nullable _ -> false
  | Object _ -> true
  | Option _ -> false
  | Promise _ -> true
  | Record _ -> true
  | Tuple _ -> true
  | TypeVar _ -> false
  | Variant _ -> false

type label = Nolabel | Label of string | OptLabel of string

type dep =
  | External of string
  | Internal of ResolvedName.t
  | Dot of dep * string

module ScopedPackage = (* Taken from ext_namespace.ml in bukclescript *)
struct
  let namespace_of_package_name (s : string) : string =
    let len = String.length s in
    let buf = Buffer.create len in
    let add capital ch =
      Buffer.add_char buf (if capital then Char.uppercase_ascii ch else ch)
    in
    let rec aux capital off len =
      if off >= len then ()
      else
        let ch = String.unsafe_get s off in
        match ch with
        | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' ->
            add capital ch;
            aux false (off + 1) len
        | '/' | '-' -> aux true (off + 1) len
        | _ -> aux capital (off + 1) len
    in
    aux true 0 len;
    Buffer.contents buf

  (** @demo/some-library -> DemoSomelibrary *)
  let packageNameToGeneratedModuleName packageName =
    if String.contains packageName '/' then
      Some (packageName |> namespace_of_package_name)
    else None

  let isGeneratedModule id ~(config : Config.t) =
    config.bsDependencies
    |> List.exists (fun packageName ->
           packageName |> packageNameToGeneratedModuleName
           = Some (id |> Ident.name))

  (** (Common, DemoSomelibrary) -> Common-DemoSomelibrary *)
  let addGeneratedModule s ~generatedModule =
    s ^ "-" ^ Ident.name generatedModule

  (** Common-DemoSomelibrary -> Common *)
  let removeGeneratedModule s =
    match s |> String.split_on_char '-' with [ name; _scope ] -> name | _ -> s
end

let rec depToString dep =
  match dep with
  | External name -> name |> ScopedPackage.removeGeneratedModule
  | Internal resolvedName -> resolvedName |> ResolvedName.toString
  | Dot (d, s) -> depToString d ^ "_" ^ s

let rec depToResolvedName (dep : dep) =
  match dep with
  | External name -> name |> ResolvedName.fromString
  | Internal resolvedName -> resolvedName
  | Dot (p, s) -> ResolvedName.dot s (p |> depToResolvedName)

let createVariant ~bsStringOrInt ~inherits ~noPayloads ~payloads ~polymorphic =
  let hash =
    noPayloads
    |> List.map (fun case -> (case.label, case.labelJS))
    |> Array.of_list |> Hashtbl.hash
  in
  let unboxed = payloads = [] in
  Variant
    {
      bsStringOrInt;
      hash;
      inherits;
      noPayloads;
      payloads;
      polymorphic;
      unboxed;
    }

let variantTable hash ~toJS =
  (match toJS with true -> "$$toJS" | false -> "$$toRE") ^ string_of_int hash

let ident ?(builtin = true) ?(typeArgs = []) name =
  Ident { builtin; name; typeArgs }

let sanitizeTypeName name = name |> String.map (function '\'' -> '_' | c -> c)
let unknown = ident "unknown"
let booleanT = ident "boolean"
let dateT = ident "Date"
let numberT = ident "number"
let stringT = ident "string"
let unitT = ident "void"
let int64T = Tuple [ numberT; numberT ]

module NodeFilename = struct
  include Filename

  (* Force "/" separator. *)
  let dirSep = "/"

  module Path : sig
    type t

    val normalize : string -> t
    val concat : t -> string -> t
    val toString : t -> string
  end = struct
    type t = string

    let normalize path : t =
      match Sys.os_type with
      | "Win32" -> path |> String.split_on_char '\\' |> String.concat dirSep
      | _ -> path

    let toString path = path
    let length path = String.length path

    let concat dirname filename =
      let isDirSep s i =
        let c = s.[i] in
        c = '/' || c = '\\' || c = ':'
      in
      let l = length dirname in
      if l = 0 || isDirSep dirname (l - 1) then dirname ^ filename
      else dirname ^ dirSep ^ filename
  end

  let concat (dirname : string) filename =
    let open Path in
    Path.concat (normalize dirname) filename |> toString
end