Fix tracer support for options (was crashing)

RELEASE_NOTES.md

@@ -1,3 +1,6 @@
+## 4.1.0
+* Fix support for `Option`s in Elmish.Tracers.console
+
 ## 4.0.3
 * Small optimization in param parsing
 

build.fsx

@@ -1,10 +1,10 @@
 #!/usr/bin/env -S dotnet fsi
-#r "nuget: Fake.Core.Target"
-#r "nuget: Fake.IO.FileSystem"
-#r "nuget: Fake.DotNet.Cli"
-#r "nuget: Fake.Core.Target"
-#r "nuget: Fake.Core.ReleaseNotes"
-#r "nuget: Fake.Tools.Git"
+#r "nuget: Fake.Core.Target, 5.23.1"
+#r "nuget: Fake.IO.FileSystem, 5.23.1"
+#r "nuget: Fake.DotNet.Cli, 5.23.1"
+#r "nuget: Fake.Core.Target, 5.23.1"
+#r "nuget: Fake.Core.ReleaseNotes, 5.23.1"
+#r "nuget: Fake.Tools.Git, 5.23.1"
 
 open Fake.Core
 open Fake.Core.TargetOperators

src/tracers.fs

@@ -5,32 +5,77 @@ open System
 open Fable.Core
 
 let getMsgNameAndFields (t: Type) (x: 'Msg) : string * obj =
-    let rec getCaseName (t: Type) (acc: string list) (x: obj) =
-        let caseName = Reflection.getCaseName x
 
-        let uci =
-            Reflection.FSharpType.GetUnionCases(t)
-            |> Array.find (fun uci -> uci.Name = caseName)
+    let getLongName (t: Type) = sprintf "%s.%s"t.Namespace t.Name
+
+    let isOption (t: Type) = getLongName t = "Microsoft.FSharp.Core.FSharpOption`1"
+
+    let isUnion (t: Type) = isOption t || Reflection.FSharpType.IsUnion t
 
-        let acc = (Reflection.getCaseName x) :: acc
-        let fields = Reflection.getCaseFields x
+    let getUnionFields x (t: Type) =
+        if isOption t then
+            // Options are special-cased because they are erased by Fable,
+            // and thus do not return true for IsUnion().
+            // (IsUnion() returns true for options on platforms other than Fable)
+            let value = box x
+            if isNull value then
+                {|
+                    CaseName = "None"
+                    FieldsValues = [||]
+                    FieldsTypes = [||]
+                |}
+            else
+                let value =
+                    #if FABLE_COMPILER
+                    value
+                    #else
+                    let _, field = FSharp.Reflection.FSharpValue.GetUnionFields(value, t)
+                    field[0]
+                    #endif
+                let valueType = t.GenericTypeArguments[0]
+                {|
+                    CaseName = "Some"
+                    FieldsValues = [| value |]
+                    FieldsTypes = [| {| Type = valueType; FieldName = "Value"; IsUnion = isUnion valueType |} |]
+
+                |}
+        else // Not a Union:
+            let uci, ucFields = Reflection.FSharpValue.GetUnionFields(x, t)
+            {|
+                CaseName = uci.Name
+                FieldsValues = ucFields
+                FieldsTypes =
+                    uci.GetFields()
+                    |> Array.map (fun x ->{|
+                        Type = x.PropertyType
+                        FieldName = x.Name
+                        IsUnion = isUnion x.PropertyType |})
+            |}
+
+    let rec getCaseName (t: Type) (acc: string list) (x: obj) =
+        let ucInfo = getUnionFields x t
+        let acc = ucInfo.CaseName :: acc
 
-        if fields.Length = 1 && Reflection.isUnion fields.[0] then
-            getCaseName (uci.GetFields().[0].PropertyType) acc fields.[0]
-        else
+        match ucInfo.FieldsTypes with
+        | [| fieldInfo |] when fieldInfo.IsUnion -> getCaseName fieldInfo.Type acc ucInfo.FieldsValues[0]
+        | fieldsTypes ->
             // Case names are intentionally left reverted so we see
             // the most meaningful message first
             let msgName = acc |> String.concat "/"
 
             let fields =
-                (uci.GetFields(), fields)
+                (fieldsTypes, ucInfo.FieldsValues)
                 ||> Array.zip
-                |> Array.map (fun (fi, v) -> fi.Name, v)
+                |> Array.map (fun (fi, v) -> fi.FieldName, v)
+                #if FABLE_COMPILER
                 |> JsInterop.createObj
+                #else
+                |> box
+                #endif
 
             msgName, fields
 
-    if Reflection.isUnion x then
+    if isUnion t then
         getCaseName t [] x
     else
         "Msg", box x

tests/Fable.Elmish.Browser.Tests.fsproj

@@ -6,6 +6,7 @@
     <ProjectReference Include="../src/Fable.Elmish.Browser.fsproj" />
   </ItemGroup>
   <ItemGroup>
+    <Compile Include="TracersTests.fs" />
     <Compile Include="ParserTests.fs" />
   </ItemGroup>
   <ItemGroup>

tests/TracersTests.fs

@@ -0,0 +1,109 @@
+module Elmish.TracersTests
+
+open Swensen.Unquote
+open NUnit.Framework
+
+type ChildMsg =
+    | ChildMsgNoField
+    | ChildMsgOneIntField of int
+    | ChildMsgTwoStringAndIntField of childStr: string * childInt: int
+
+type RootMsg =
+    | RootMsgNoField
+    | RootMsgOneIntField of int
+    | RootMsgTwoStringAndIntField of str: string * int: int
+    | RootMsgOneChildField of ChildMsg
+    | RootMsgOneIntOptionField of int option
+    | RootMsgOneChildOptionField of ChildMsg option
+    | RootMsgIntOptionOption of int option option
+
+let getTraceForMsg (msg: 'Msg) =
+    let actualName, actualValues = Tracers.getMsgNameAndFields typeof<'Msg> msg
+    let actualValues = 
+        actualValues :?> (string * obj) array
+        |> Array.toList // So that we can compare the actual vs expected by value in the tests.
+    actualName, actualValues
+
+[<Test>]
+let ``getMsgNameAndFields for RootMsg.RootMsgNoField`` () =
+    getTraceForMsg (RootMsg.RootMsgNoField)
+    =! (nameof (RootMsg.RootMsgNoField), 
+        [])
+
+[<Test>]
+let ``getMsgNameAndFields for RootMsg.RootMsgOneIntField`` () =
+    getTraceForMsg (RootMsg.RootMsgOneIntField 42)
+    =! (nameof (RootMsg.RootMsgOneIntField),
+        [ ("Item", 42) ])
+
+[<Test>]
+let ``getMsgNameAndFields for RootMsg.RootMsgTwoStringAndIntField`` () =
+    getTraceForMsg (RootMsg.RootMsgTwoStringAndIntField("test", 42))
+    =! (nameof (RootMsg.RootMsgTwoStringAndIntField),
+        [ ("str", "test"); ("int", 42) ])
+
+[<Test>]
+let ``getMsgNameAndFields for RootMsg.RootMsgOneChildField, ChildMsg.ChildMsgNoField`` () =
+    getTraceForMsg (RootMsg.RootMsgOneChildField(ChildMsg.ChildMsgNoField))
+    =! ($"{nameof ChildMsg.ChildMsgNoField}/{nameof (RootMsg.RootMsgOneChildField)}", 
+        [])
+
+[<Test>]
+let ``getMsgNameAndFields for RootMsg.RootMsgOneChildField, ChildMsg.ChildMsgOneIntField`` () =
+    getTraceForMsg (RootMsg.RootMsgOneChildField(ChildMsg.ChildMsgOneIntField(42)))
+    =! ($"{nameof ChildMsg.ChildMsgOneIntField}/{nameof (RootMsg.RootMsgOneChildField)}",
+        [ ("Item", 42) ])
+
+[<Test>]
+let ``getMsgNameAndFields for RootMsg.RootMsgOneChildField, ChildMsg.ChildMsgTwoStringAndIntField`` () =
+    getTraceForMsg (RootMsg.RootMsgOneChildField(ChildMsg.ChildMsgTwoStringAndIntField("test", 42)))
+    =! ($"{nameof ChildMsg.ChildMsgTwoStringAndIntField}/{nameof (RootMsg.RootMsgOneChildField)}", 
+        [ ("childStr", "test"); ("childInt", 42) ])
+
+[<Test>]
+let ``getMsgNameAndFields for RootMsg.RootMsgOneIntOptionField, None`` () =
+    getTraceForMsg (RootMsg.RootMsgOneIntOptionField(None))
+    =! ($"None/{nameof (RootMsg.RootMsgOneIntOptionField)}",
+        [])
+
+[<Test>]
+let ``getMsgNameAndFields for RootMsg.RootMsgOneIntOptionField, Some`` () =
+    getTraceForMsg (RootMsg.RootMsgOneIntOptionField(Some 42))
+    =! ($"Some/{nameof (RootMsg.RootMsgOneIntOptionField)}",
+        [ ("Value", 42) ])
+
+[<Test>]
+let ``getMsgNameAndFields for RootMsg.RootMsgOneChildOptionField, None`` () =
+    getTraceForMsg (RootMsg.RootMsgOneChildOptionField(None))
+    =! ($"None/{nameof (RootMsg.RootMsgOneChildOptionField)}",
+        [])
+
+[<Test>]
+let ``getMsgNameAndFields for RootMsg.RootMsgOneChildOptionField, Some ChildMsgNoField`` () =
+    getTraceForMsg (RootMsg.RootMsgOneChildOptionField(Some(ChildMsgNoField)))
+    =! ($"{nameof (ChildMsg.ChildMsgNoField)}/Some/{nameof (RootMsg.RootMsgOneChildOptionField)}",
+        [])
+
+[<Test>]
+let ``getMsgNameAndFields for RootMsg.RootMsgOneChildOptionField, Some ChildMsgOneIntField`` () =
+    getTraceForMsg (RootMsg.RootMsgOneChildOptionField(Some(ChildMsgOneIntField 42)))
+    =! ($"{nameof (ChildMsg.ChildMsgOneIntField)}/Some/{nameof (RootMsg.RootMsgOneChildOptionField)}",
+        [ ("Item", 42) ])
+
+[<Test>]
+let ``getMsgNameAndFields for RootMsg.RootMsgOneChildOptionField, Some ChildMsgTwoStringAndIntField`` () =
+    getTraceForMsg (RootMsg.RootMsgOneChildOptionField(Some(ChildMsgTwoStringAndIntField("test", 42))))
+    =! ($"{nameof (ChildMsg.ChildMsgTwoStringAndIntField)}/Some/{nameof (RootMsg.RootMsgOneChildOptionField)}",
+        [ ("childStr", "test"); ("childInt", 42) ])
+
+[<Test>]
+let ``getMsgNameAndFields for RootMsg.RootMsgIntOptionOption, Some, None`` () =
+    getTraceForMsg (RootMsg.RootMsgIntOptionOption(Some(None)))
+    =! ($"None/Some/{nameof (RootMsg.RootMsgIntOptionOption)}",
+        [])
+
+[<Test>]
+let ``getMsgNameAndFields for RootMsg.RootMsgIntOptionOption, Some, Some`` () =
+    getTraceForMsg (RootMsg.RootMsgIntOptionOption(Some(Some 42)))
+    =! ($"Some/Some/{nameof (RootMsg.RootMsgIntOptionOption)}",
+        [ ("Value", 42) ])