diff --git a/RELEASE_NOTES.md b/RELEASE_NOTES.md index e4ca51a..9c2cd59 100644 --- a/RELEASE_NOTES.md +++ b/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 diff --git a/build.fsx b/build.fsx index 6d97467..9c92b36 100755 --- a/build.fsx +++ b/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 diff --git a/src/tracers.fs b/src/tracers.fs index 0020eb8..bb6583f 100644 --- a/src/tracers.fs +++ b/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 diff --git a/tests/Fable.Elmish.Browser.Tests.fsproj b/tests/Fable.Elmish.Browser.Tests.fsproj index 4948107..8c4f131 100644 --- a/tests/Fable.Elmish.Browser.Tests.fsproj +++ b/tests/Fable.Elmish.Browser.Tests.fsproj @@ -6,6 +6,7 @@ + diff --git a/tests/TracersTests.fs b/tests/TracersTests.fs new file mode 100644 index 0000000..8bc8acb --- /dev/null +++ b/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 + +[] +let ``getMsgNameAndFields for RootMsg.RootMsgNoField`` () = + getTraceForMsg (RootMsg.RootMsgNoField) + =! (nameof (RootMsg.RootMsgNoField), + []) + +[] +let ``getMsgNameAndFields for RootMsg.RootMsgOneIntField`` () = + getTraceForMsg (RootMsg.RootMsgOneIntField 42) + =! (nameof (RootMsg.RootMsgOneIntField), + [ ("Item", 42) ]) + +[] +let ``getMsgNameAndFields for RootMsg.RootMsgTwoStringAndIntField`` () = + getTraceForMsg (RootMsg.RootMsgTwoStringAndIntField("test", 42)) + =! (nameof (RootMsg.RootMsgTwoStringAndIntField), + [ ("str", "test"); ("int", 42) ]) + +[] +let ``getMsgNameAndFields for RootMsg.RootMsgOneChildField, ChildMsg.ChildMsgNoField`` () = + getTraceForMsg (RootMsg.RootMsgOneChildField(ChildMsg.ChildMsgNoField)) + =! ($"{nameof ChildMsg.ChildMsgNoField}/{nameof (RootMsg.RootMsgOneChildField)}", + []) + +[] +let ``getMsgNameAndFields for RootMsg.RootMsgOneChildField, ChildMsg.ChildMsgOneIntField`` () = + getTraceForMsg (RootMsg.RootMsgOneChildField(ChildMsg.ChildMsgOneIntField(42))) + =! ($"{nameof ChildMsg.ChildMsgOneIntField}/{nameof (RootMsg.RootMsgOneChildField)}", + [ ("Item", 42) ]) + +[] +let ``getMsgNameAndFields for RootMsg.RootMsgOneChildField, ChildMsg.ChildMsgTwoStringAndIntField`` () = + getTraceForMsg (RootMsg.RootMsgOneChildField(ChildMsg.ChildMsgTwoStringAndIntField("test", 42))) + =! ($"{nameof ChildMsg.ChildMsgTwoStringAndIntField}/{nameof (RootMsg.RootMsgOneChildField)}", + [ ("childStr", "test"); ("childInt", 42) ]) + +[] +let ``getMsgNameAndFields for RootMsg.RootMsgOneIntOptionField, None`` () = + getTraceForMsg (RootMsg.RootMsgOneIntOptionField(None)) + =! ($"None/{nameof (RootMsg.RootMsgOneIntOptionField)}", + []) + +[] +let ``getMsgNameAndFields for RootMsg.RootMsgOneIntOptionField, Some`` () = + getTraceForMsg (RootMsg.RootMsgOneIntOptionField(Some 42)) + =! ($"Some/{nameof (RootMsg.RootMsgOneIntOptionField)}", + [ ("Value", 42) ]) + +[] +let ``getMsgNameAndFields for RootMsg.RootMsgOneChildOptionField, None`` () = + getTraceForMsg (RootMsg.RootMsgOneChildOptionField(None)) + =! ($"None/{nameof (RootMsg.RootMsgOneChildOptionField)}", + []) + +[] +let ``getMsgNameAndFields for RootMsg.RootMsgOneChildOptionField, Some ChildMsgNoField`` () = + getTraceForMsg (RootMsg.RootMsgOneChildOptionField(Some(ChildMsgNoField))) + =! ($"{nameof (ChildMsg.ChildMsgNoField)}/Some/{nameof (RootMsg.RootMsgOneChildOptionField)}", + []) + +[] +let ``getMsgNameAndFields for RootMsg.RootMsgOneChildOptionField, Some ChildMsgOneIntField`` () = + getTraceForMsg (RootMsg.RootMsgOneChildOptionField(Some(ChildMsgOneIntField 42))) + =! ($"{nameof (ChildMsg.ChildMsgOneIntField)}/Some/{nameof (RootMsg.RootMsgOneChildOptionField)}", + [ ("Item", 42) ]) + +[] +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) ]) + +[] +let ``getMsgNameAndFields for RootMsg.RootMsgIntOptionOption, Some, None`` () = + getTraceForMsg (RootMsg.RootMsgIntOptionOption(Some(None))) + =! ($"None/Some/{nameof (RootMsg.RootMsgIntOptionOption)}", + []) + +[] +let ``getMsgNameAndFields for RootMsg.RootMsgIntOptionOption, Some, Some`` () = + getTraceForMsg (RootMsg.RootMsgIntOptionOption(Some(Some 42))) + =! ($"Some/Some/{nameof (RootMsg.RootMsgIntOptionOption)}", + [ ("Value", 42) ])