Rebase

Author: cannorin

lib/Extensions.fs

@@ -51,6 +51,11 @@ module String =
       state.Replace(e, "\\" + e)
     ) s
 
+module Option =
+  let iterNone f = function
+    | Some x -> Some x
+    | None -> f (); None
+
 module Result =
   let toOption result =
     match result with Ok x -> Some x | Error _ -> None
@@ -101,7 +106,11 @@ open Fable.Core.JsInterop
 
 type JS.ObjectConstructor with
   [<Emit("$0.entries($1)")>]
-  member __.entries (x: 'a) : (string * obj) [] = jsNative
+  member __.entries (_: 'a) : (string * obj) [] = jsNative
+
+type JS.NumberConstructor with
+  [<Emit("$0.isSafeInteger($1)")>]
+  member __.isSafeInteger (_: float) : bool = jsNative
 
 type JSRecord<'TKey, 'TValue> =
   [<EmitIndexer>]
@@ -157,6 +166,9 @@ module Path =
   let dirname (path: string) : string =
     Node.path.dirname(path)
 
+  let basename (path: string) : string =
+    Node.path.basename(path)
+
   let join (paths: string list) : string =
     Node.path.join(Array.ofList paths)
 

lib/JsHelper.fs

@@ -45,7 +45,7 @@ type IPackageJson =
   abstract version: string
   abstract types: string option
   abstract typings: string option
-  abstract exports: JSRecord<string, IPackageExportItem> option
+  abstract exports: JSRecord<string, U2<string, IPackageExportItem>> option
 
 let getPackageInfo (exampleFilePath: string) : Syntax.PackageInfo option =
   nodeOnly <| fun () ->
@@ -77,23 +77,28 @@ let getPackageInfo (exampleFilePath: string) : Syntax.PackageInfo option =
         | Some exports ->
           [
             for k, v in exports.entries do
-              match v.types with
-              | None -> ()
-              | Some types ->
-                if JS.typeof types = "string" then
-                  yield k, !!types
-                else
-                  let types = !!types : IPackageExportItemEntry
-                  match types.``default`` with
-                  | Some v -> yield k, v
-                  | None ->
-                    yield!
-                      types.entries
-                      |> Array.tryPick (fun (_, v) ->
-                        if JS.typeof v = "string" && v.EndsWith(".d.ts") then Some v
-                        else None)
-                      |> Option.map (fun v -> k, v)
-                      |> Option.toList
+              if JS.typeof v = "string" then
+                let v = !!v : string
+                if v.EndsWith(".d.ts") then yield k, v
+              else
+                let v = !!v : IPackageExportItem
+                match v.types with
+                | None -> ()
+                | Some types ->
+                  if JS.typeof types = "string" then
+                    yield k, !!types
+                  else
+                    let types = !!types : IPackageExportItemEntry
+                    match types.``default`` with
+                    | Some v -> yield k, v
+                    | None ->
+                      yield!
+                        types.entries
+                        |> Array.tryPick (fun (_, v) ->
+                          if JS.typeof v = "string" && v.EndsWith(".d.ts") then Some v
+                          else None)
+                        |> Option.map (fun v -> k, v)
+                        |> Option.toList
           ]
 
       let indexFile =
@@ -141,18 +146,18 @@ let inferPackageInfoFromFileName (sourceFile: Path.Absolute) : {| name: string;
       |> fun x ->
         let inm = x.LastIndexOf "node_modules"
         if inm = -1 then x
-        else x.Substring(inm+13)
+        else x.Substring(inm)
       |> String.split "/"
       |> List.ofArray
   match parts with
-  | [] -> None
-  | "@types" :: name :: rest ->
+  | "node_modules" :: "@types" :: name :: rest ->
     let name = if name.Contains("__") then "@" + name.Replace("__", "/") else name
     Some {| name = name; isDefinitelyTyped = true; rest = rest |}
-  | user :: name :: rest when user.StartsWith("@") ->
-    Some {| name = user + "/" + name; isDefinitelyTyped = true; rest = rest |}
-  | name :: rest ->
-    Some {| name = name; isDefinitelyTyped = true; rest = rest |}
+  | "node_modules" :: user :: name :: rest when user.StartsWith("@") ->
+    Some {| name = user + "/" + name; isDefinitelyTyped = false; rest = rest |}
+  | "node_modules" :: name :: rest ->
+    Some {| name = name; isDefinitelyTyped = false; rest = rest |}
+  | _ -> None
 
 let inline stripExtension path =
   path |> String.replace ".ts" "" |> String.replace ".d" ""
@@ -184,7 +189,8 @@ let getJsModuleName (info: Syntax.PackageInfo option) (sourceFile: Path.Absolute
           Path.join [info.name; submodule] |> Heuristic
   | None ->
     match inferPackageInfoFromFileName sourceFile with
-    | None -> Unknown
+    | None ->
+      Path.basename sourceFile |> stripExtension |> Heuristic
     | Some info ->
       if info.isDefinitelyTyped then
         let rest =

lib/Parser.fs

@@ -707,12 +707,21 @@ module private ParserImpl =
     match getPropertyName em.name with
     | Some name ->
       let value =
+        let inline fallback () =
+          match ctx.checker.getConstantValue(!^em) with
+          | None -> None
+          | Some (U2.Case1 str) -> Some (LString str)
+          | Some (U2.Case2 num) ->
+            if Fable.Core.JS.Constructors.Number.isSafeInteger(num) then Some (LInt (int num))
+            else Some (LFloat num)
         match em.initializer with
-        | None -> None
+        | None -> fallback ()
         | Some ep ->
           match readLiteral ep with
-          | Some ((LInt _ | LString _) as l) -> Some l
-          | _ -> nodeWarn ctx ep "enum value '%s' for case '%s' not supported" (ep.getText()) name; None
+          | Some ((LInt _ | LFloat _ | LString _) as l) -> Some l
+          | _ ->
+            fallback () |> Option.iterNone (fun () ->
+              nodeWarn ctx ep "enum value '%s' for case '%s' not supported" (ep.getText()) name)
       let comments = readCommentsForNamedDeclaration ctx em
       Some { comments = comments; loc = Node.location em; name = name; value = value }
     | None -> nodeWarn ctx em "unsupported enum case name '%s'" (getText em.name); None

lib/Typer.fs

@@ -1376,6 +1376,25 @@ module ResolvedUnion =
       resolveUnionMap <- resolveUnionMap |> Map.add u result
       result
 
+let inferEnumCaseValue (stmts: Statement list) : Statement list =
+  let rec go = function
+    | Enum e ->
+      let f (state: Literal option) (c: EnumCase) : EnumCase * Literal option =
+        match c.value with
+        | Some v -> c, Some v
+        | None ->
+          let v =
+            match state with
+            | None -> Some (LInt 0)
+            | Some (LInt n) -> Some (LInt (n+1))
+            | Some (LFloat f) -> Some (LFloat (f+1.0))
+            | Some _ -> None
+          { c with value = v }, v
+      Enum { e with cases = e.cases |> List.mapFold f None |> fst }
+    | Module m -> Module { m with statements = m.statements |> List.map go }
+    | s -> s
+  stmts |> List.map go
+
 let rec mergeStatements (stmts: Statement list) =
   let mutable result : Choice<Statement, Class ref, Module ref> list = []
 
@@ -1765,7 +1784,7 @@ let runAll (srcs: SourceFile list) (baseCtx: IContext<#TyperOptions>) =
   let inline withSourceFileContext ctx f (src: SourceFile) =
     f (ctx |> TyperContext.ofSourceFileRoot src.fileName) src
 
-  let result = srcs |> List.map (mapStatements mergeStatements)
+  let result = srcs |> List.map (mapStatements (inferEnumCaseValue >> mergeStatements))
 
   // build a context
   let ctx = createRootContextForTyper result baseCtx