From de74c9eafe7e19956da8864d361bdf5942879cda Mon Sep 17 00:00:00 2001 From: cabboose Date: Sun, 22 Jun 2025 17:28:51 +0800 Subject: [PATCH 1/5] =StringEnum Enhancement= - Adds optional boolean switch as second positional argument which toggles StringEnum respecting CompiledValue attributes. - Adds tests for StringEnum respecting CompiledValue - Adds remarks to xml docs to add this usage possibility --- src/Fable.Core/Fable.Core.Types.fs | 19 ++++++++++++++--- src/Fable.Transforms/FSharp2Fable.Util.fs | 26 +++++++++++++++++------ src/Fable.Transforms/FSharp2Fable.fs | 15 +++++++------ tests/Js/Main/JsInteropTests.fs | 11 ++++++++++ 4 files changed, 55 insertions(+), 16 deletions(-) diff --git a/src/Fable.Core/Fable.Core.Types.fs b/src/Fable.Core/Fable.Core.Types.fs index 1641884a0..fbc3ebaff 100644 --- a/src/Fable.Core/Fable.Core.Types.fs +++ b/src/Fable.Core/Fable.Core.Types.fs @@ -96,12 +96,25 @@ type EmitIndexerAttribute() = type EmitPropertyAttribute(propertyName: string) = inherit Attribute() +/// /// Compile union types as string literals. -/// More info: https://fable.io/docs/communicate/js-from-fable.html#stringenum-attribute +/// +/// +/// By default, StringEnum does not respect the CompiledValue attribute on cases. This can be toggled +/// by enabling the respectValues switch: +/// +/// [<StringEnum(caseRules = CaseRules.LowerFirst, respectValues = true)>] +/// [<StringEnum(CaseRules.LowerFirst, true)>] +/// +/// +/// +/// Docs section on StringEnum +/// [] -type StringEnumAttribute(caseRules: CaseRules) = +type StringEnumAttribute(caseRules: CaseRules, respectValues: bool) = inherit Attribute() - new() = StringEnumAttribute(CaseRules.LowerFirst) + new() = StringEnumAttribute(CaseRules.LowerFirst, false) + new(caseRules: CaseRules) = StringEnumAttribute(caseRules, false) /// Used to spread the last argument. Mainly intended for `React.createElement` binding, not for general use. [] diff --git a/src/Fable.Transforms/FSharp2Fable.Util.fs b/src/Fable.Transforms/FSharp2Fable.Util.fs index ed0e795be..49a125a24 100644 --- a/src/Fable.Transforms/FSharp2Fable.Util.fs +++ b/src/Fable.Transforms/FSharp2Fable.Util.fs @@ -938,11 +938,19 @@ module Helpers = failwith $"Cannot find case %s{unionCase.Name} in %s{FsEnt.FullName ent}" /// Apply case rules to case name if there's no explicit compiled name - let transformStringEnum (rule: CaseRules) (unionCase: FSharpUnionCase) = + let transformStringEnum (rule: CaseRules) (shouldRespectValue: bool) (unionCase: FSharpUnionCase) = match FsUnionCase.CompiledName unionCase with - | Some name -> name - | None -> Naming.applyCaseRule rule unionCase.Name - |> makeStrConst + | Some name -> name |> makeStrConst + | None -> + if shouldRespectValue then + FsUnionCase.CompiledValue unionCase + |> function + | None -> Naming.applyCaseRule rule unionCase.Name |> makeStrConst + | Some(CompiledValue.Boolean value) -> makeBoolConst value + | Some(CompiledValue.Float value) -> makeFloatConst value + | Some(CompiledValue.Integer value) -> makeIntConst value + else + Naming.applyCaseRule rule unionCase.Name |> makeStrConst // let isModuleMember (memb: FSharpMemberOrFunctionOrValue) = // match memb.DeclaringEntity with @@ -1012,7 +1020,7 @@ module Helpers = | ErasedUnion of tdef: FSharpEntity * genArgs: IList * rule: CaseRules | ErasedUnionCase | TypeScriptTaggedUnion of tdef: FSharpEntity * genArgs: IList * tagName: string * rule: CaseRules - | StringEnum of tdef: FSharpEntity * rule: CaseRules + | StringEnum of tdef: FSharpEntity * rule: CaseRules * respectsValue: bool | DiscriminatedUnion of tdef: FSharpEntity * genArgs: IList let getUnionPattern (typ: FSharpType) (unionCase: FSharpUnionCase) : UnionPattern = @@ -1022,6 +1030,12 @@ module Helpers = match Seq.tryHead att.ConstructorArguments with | Some(_, (:? int as rule)) -> enum (rule) | _ -> CaseRules.LowerFirst + // Used in matching StringEnum attributes. Checks if the string enum + // will respect CompiledValue attributes + let shouldRespectValue (att: FSharpAttribute) = + match Seq.tryItem 1 att.ConstructorArguments with + | Some(_, (:? bool as value)) -> value + | _ -> false unionCase.Attributes |> Seq.tryPick (fun att -> @@ -1042,7 +1056,7 @@ module Helpers = |> Seq.tryPick (fun att -> match att.AttributeType.TryFullName with | Some Atts.erase -> Some(ErasedUnion(tdef, typ.GenericArguments, getCaseRule att)) - | Some Atts.stringEnum -> Some(StringEnum(tdef, getCaseRule att)) + | Some Atts.stringEnum -> Some(StringEnum(tdef, getCaseRule att, shouldRespectValue att)) | Some Atts.tsTaggedUnion -> match Seq.tryItem 0 att.ConstructorArguments, Seq.tryItem 1 att.ConstructorArguments with | Some(_, (:? string as name)), None -> diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index d8e07c19e..e6f5bec7f 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -64,7 +64,7 @@ let private transformNewUnion com ctx r fsType (unionCase: FSharpUnionCase) (arg | ErasedUnion(tdef, _genArgs, rule) -> match argExprs with - | [] -> transformStringEnum rule unionCase + | [] -> transformStringEnum rule false unionCase | [ argExpr ] -> argExpr | _ when tdef.UnionCases.Count > 1 -> "Erased unions with multiple cases must have one single field: " @@ -78,7 +78,7 @@ let private transformNewUnion com ctx r fsType (unionCase: FSharpUnionCase) (arg | _ -> let isCompiledValue, tagExpr = match FsUnionCase.CompiledValue unionCase with - | None -> false, transformStringEnum rule unionCase + | None -> false, transformStringEnum rule false unionCase | Some(CompiledValue.Integer i) -> false, makeIntConst i | Some(CompiledValue.Float f) -> false, makeFloatConst f | Some(CompiledValue.Boolean b) -> false, makeBoolConst b @@ -104,9 +104,9 @@ let private transformNewUnion com ctx r fsType (unionCase: FSharpUnionCase) (arg ) |> makeValue r - | StringEnum(tdef, rule) -> + | StringEnum(tdef, rule, shouldRespectValue) -> match argExprs with - | [] -> transformStringEnum rule unionCase + | [] -> transformStringEnum rule shouldRespectValue unionCase | _ -> $"StringEnum types cannot have fields: {tdef.TryFullName}" |> addErrorAndReturnNull com ctx.InlinePath r @@ -507,7 +507,7 @@ let private transformUnionCaseTest | ErasedUnion(tdef, genArgs, rule) -> match unionCase.Fields.Count with - | 0 -> return makeEqOp r unionExpr (transformStringEnum rule unionCase) BinaryEqual + | 0 -> return makeEqOp r unionExpr (transformStringEnum rule false unionCase) BinaryEqual | 1 -> let fi = unionCase.Fields[0] @@ -533,7 +533,7 @@ let private transformUnionCaseTest | TypeScriptTaggedUnion(_, _, tagName, rule) -> let isCompiledValue, value = match FsUnionCase.CompiledValue unionCase with - | None -> false, transformStringEnum rule unionCase + | None -> false, transformStringEnum rule false unionCase | Some(CompiledValue.Integer i) -> true, makeIntConst i | Some(CompiledValue.Float f) -> true, makeFloatConst f | Some(CompiledValue.Boolean b) -> true, makeBoolConst b @@ -558,7 +558,8 @@ let private transformUnionCaseTest let kind = Fable.ListTest(unionCase.CompiledName <> "Empty") return Fable.Test(unionExpr, kind, r) - | StringEnum(_, rule) -> return makeEqOp r unionExpr (transformStringEnum rule unionCase) BinaryEqual + | StringEnum(_, rule, shouldRespectValue) -> + return makeEqOp r unionExpr (transformStringEnum rule shouldRespectValue unionCase) BinaryEqual | DiscriminatedUnion(tdef, _) -> let tag = unionCaseTag com tdef unionCase diff --git a/tests/Js/Main/JsInteropTests.fs b/tests/Js/Main/JsInteropTests.fs index b44ad5c69..068e937b1 100644 --- a/tests/Js/Main/JsInteropTests.fs +++ b/tests/Js/Main/JsInteropTests.fs @@ -225,6 +225,11 @@ type LowerAllOptions = | ContentBox | BorderBox +[] +type RespectValues = + | ContentBox + | [] None + [] #endif type Field = OldPassword | NewPassword | ConfirmPassword @@ -829,6 +834,12 @@ let tests = let x = LowerAllOptions.ContentBox x |> unbox |> equal "contentbox" + testCase "StringEnum works with RespectCompiledValue" <| fun () -> + let x = RespectValues.ContentBox + x |> unbox |> equal "contentbox" + let y = RespectValues.None + y |> unbox |> equal false + // See https://github.com/fable-compiler/fable-import/issues/72 testCase "Can use values and functions from global modules" <| fun () -> GlobalModule.add 3 4 |> equal 7 From 664c54f369c88aeaf61613936076796577388b03 Mon Sep 17 00:00:00 2001 From: cabboose Date: Sun, 22 Jun 2025 17:44:58 +0800 Subject: [PATCH 2/5] greenlight standalone test --- src/Fable.Transforms/Global/Fable.Core.fs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Fable.Transforms/Global/Fable.Core.fs b/src/Fable.Transforms/Global/Fable.Core.fs index fefa06ea1..06c1c8d68 100644 --- a/src/Fable.Transforms/Global/Fable.Core.fs +++ b/src/Fable.Transforms/Global/Fable.Core.fs @@ -21,3 +21,4 @@ type CaseRules = type StringEnumAttribute() = inherit Attribute() new(caseRules: CaseRules) = StringEnumAttribute() + new(caseRules: CaseRules, respectValues: bool) = StringEnumAttribute() From c74d39256fad553e39d8119f9ade7e0ef283ee18 Mon Sep 17 00:00:00 2001 From: cabboose Date: Mon, 23 Jun 2025 00:30:08 +0800 Subject: [PATCH 3/5] CompiledValues take precedence for union fields of StringEnum tagged types. CompiledName takes precedence over CompiledValue --- src/Fable.Core/Fable.Core.Types.fs | 13 +++------ src/Fable.Transforms/FSharp2Fable.Util.fs | 32 +++++++---------------- src/Fable.Transforms/FSharp2Fable.fs | 15 +++++------ src/Fable.Transforms/Global/Fable.Core.fs | 1 - tests/Js/Main/JsInteropTests.fs | 23 +++++++++++----- 5 files changed, 38 insertions(+), 46 deletions(-) diff --git a/src/Fable.Core/Fable.Core.Types.fs b/src/Fable.Core/Fable.Core.Types.fs index fbc3ebaff..bddfb73fe 100644 --- a/src/Fable.Core/Fable.Core.Types.fs +++ b/src/Fable.Core/Fable.Core.Types.fs @@ -100,21 +100,16 @@ type EmitPropertyAttribute(propertyName: string) = /// Compile union types as string literals. /// /// -/// By default, StringEnum does not respect the CompiledValue attribute on cases. This can be toggled -/// by enabling the respectValues switch: -/// -/// [<StringEnum(caseRules = CaseRules.LowerFirst, respectValues = true)>] -/// [<StringEnum(CaseRules.LowerFirst, true)>] -/// +/// Use the CompiledName or CompiledValue attributes on union fields to change +/// the generated values. /// /// /// Docs section on StringEnum /// [] -type StringEnumAttribute(caseRules: CaseRules, respectValues: bool) = +type StringEnumAttribute(caseRules: CaseRules) = inherit Attribute() - new() = StringEnumAttribute(CaseRules.LowerFirst, false) - new(caseRules: CaseRules) = StringEnumAttribute(caseRules, false) + new() = StringEnumAttribute(CaseRules.LowerFirst) /// Used to spread the last argument. Mainly intended for `React.createElement` binding, not for general use. [] diff --git a/src/Fable.Transforms/FSharp2Fable.Util.fs b/src/Fable.Transforms/FSharp2Fable.Util.fs index 49a125a24..523b3ae5a 100644 --- a/src/Fable.Transforms/FSharp2Fable.Util.fs +++ b/src/Fable.Transforms/FSharp2Fable.Util.fs @@ -937,20 +937,14 @@ module Helpers = with _ -> failwith $"Cannot find case %s{unionCase.Name} in %s{FsEnt.FullName ent}" - /// Apply case rules to case name if there's no explicit compiled name - let transformStringEnum (rule: CaseRules) (shouldRespectValue: bool) (unionCase: FSharpUnionCase) = - match FsUnionCase.CompiledName unionCase with - | Some name -> name |> makeStrConst - | None -> - if shouldRespectValue then - FsUnionCase.CompiledValue unionCase - |> function - | None -> Naming.applyCaseRule rule unionCase.Name |> makeStrConst - | Some(CompiledValue.Boolean value) -> makeBoolConst value - | Some(CompiledValue.Float value) -> makeFloatConst value - | Some(CompiledValue.Integer value) -> makeIntConst value - else - Naming.applyCaseRule rule unionCase.Name |> makeStrConst + /// Apply case rules to case name if there's no explicit compiled name or compiled value + let transformStringEnum (rule: CaseRules) (unionCase: FSharpUnionCase) = + match FsUnionCase.CompiledName unionCase, FsUnionCase.CompiledValue unionCase with + | Some name, _ -> name |> makeStrConst + | _, Some(CompiledValue.Boolean value) -> makeBoolConst value + | _, Some(CompiledValue.Float value) -> makeFloatConst value + | _, Some(CompiledValue.Integer value) -> makeIntConst value + | _ -> Naming.applyCaseRule rule unionCase.Name |> makeStrConst // let isModuleMember (memb: FSharpMemberOrFunctionOrValue) = // match memb.DeclaringEntity with @@ -1020,7 +1014,7 @@ module Helpers = | ErasedUnion of tdef: FSharpEntity * genArgs: IList * rule: CaseRules | ErasedUnionCase | TypeScriptTaggedUnion of tdef: FSharpEntity * genArgs: IList * tagName: string * rule: CaseRules - | StringEnum of tdef: FSharpEntity * rule: CaseRules * respectsValue: bool + | StringEnum of tdef: FSharpEntity * rule: CaseRules | DiscriminatedUnion of tdef: FSharpEntity * genArgs: IList let getUnionPattern (typ: FSharpType) (unionCase: FSharpUnionCase) : UnionPattern = @@ -1030,12 +1024,6 @@ module Helpers = match Seq.tryHead att.ConstructorArguments with | Some(_, (:? int as rule)) -> enum (rule) | _ -> CaseRules.LowerFirst - // Used in matching StringEnum attributes. Checks if the string enum - // will respect CompiledValue attributes - let shouldRespectValue (att: FSharpAttribute) = - match Seq.tryItem 1 att.ConstructorArguments with - | Some(_, (:? bool as value)) -> value - | _ -> false unionCase.Attributes |> Seq.tryPick (fun att -> @@ -1056,7 +1044,7 @@ module Helpers = |> Seq.tryPick (fun att -> match att.AttributeType.TryFullName with | Some Atts.erase -> Some(ErasedUnion(tdef, typ.GenericArguments, getCaseRule att)) - | Some Atts.stringEnum -> Some(StringEnum(tdef, getCaseRule att, shouldRespectValue att)) + | Some Atts.stringEnum -> Some(StringEnum(tdef, getCaseRule att)) | Some Atts.tsTaggedUnion -> match Seq.tryItem 0 att.ConstructorArguments, Seq.tryItem 1 att.ConstructorArguments with | Some(_, (:? string as name)), None -> diff --git a/src/Fable.Transforms/FSharp2Fable.fs b/src/Fable.Transforms/FSharp2Fable.fs index e6f5bec7f..d8e07c19e 100644 --- a/src/Fable.Transforms/FSharp2Fable.fs +++ b/src/Fable.Transforms/FSharp2Fable.fs @@ -64,7 +64,7 @@ let private transformNewUnion com ctx r fsType (unionCase: FSharpUnionCase) (arg | ErasedUnion(tdef, _genArgs, rule) -> match argExprs with - | [] -> transformStringEnum rule false unionCase + | [] -> transformStringEnum rule unionCase | [ argExpr ] -> argExpr | _ when tdef.UnionCases.Count > 1 -> "Erased unions with multiple cases must have one single field: " @@ -78,7 +78,7 @@ let private transformNewUnion com ctx r fsType (unionCase: FSharpUnionCase) (arg | _ -> let isCompiledValue, tagExpr = match FsUnionCase.CompiledValue unionCase with - | None -> false, transformStringEnum rule false unionCase + | None -> false, transformStringEnum rule unionCase | Some(CompiledValue.Integer i) -> false, makeIntConst i | Some(CompiledValue.Float f) -> false, makeFloatConst f | Some(CompiledValue.Boolean b) -> false, makeBoolConst b @@ -104,9 +104,9 @@ let private transformNewUnion com ctx r fsType (unionCase: FSharpUnionCase) (arg ) |> makeValue r - | StringEnum(tdef, rule, shouldRespectValue) -> + | StringEnum(tdef, rule) -> match argExprs with - | [] -> transformStringEnum rule shouldRespectValue unionCase + | [] -> transformStringEnum rule unionCase | _ -> $"StringEnum types cannot have fields: {tdef.TryFullName}" |> addErrorAndReturnNull com ctx.InlinePath r @@ -507,7 +507,7 @@ let private transformUnionCaseTest | ErasedUnion(tdef, genArgs, rule) -> match unionCase.Fields.Count with - | 0 -> return makeEqOp r unionExpr (transformStringEnum rule false unionCase) BinaryEqual + | 0 -> return makeEqOp r unionExpr (transformStringEnum rule unionCase) BinaryEqual | 1 -> let fi = unionCase.Fields[0] @@ -533,7 +533,7 @@ let private transformUnionCaseTest | TypeScriptTaggedUnion(_, _, tagName, rule) -> let isCompiledValue, value = match FsUnionCase.CompiledValue unionCase with - | None -> false, transformStringEnum rule false unionCase + | None -> false, transformStringEnum rule unionCase | Some(CompiledValue.Integer i) -> true, makeIntConst i | Some(CompiledValue.Float f) -> true, makeFloatConst f | Some(CompiledValue.Boolean b) -> true, makeBoolConst b @@ -558,8 +558,7 @@ let private transformUnionCaseTest let kind = Fable.ListTest(unionCase.CompiledName <> "Empty") return Fable.Test(unionExpr, kind, r) - | StringEnum(_, rule, shouldRespectValue) -> - return makeEqOp r unionExpr (transformStringEnum rule shouldRespectValue unionCase) BinaryEqual + | StringEnum(_, rule) -> return makeEqOp r unionExpr (transformStringEnum rule unionCase) BinaryEqual | DiscriminatedUnion(tdef, _) -> let tag = unionCaseTag com tdef unionCase diff --git a/src/Fable.Transforms/Global/Fable.Core.fs b/src/Fable.Transforms/Global/Fable.Core.fs index 06c1c8d68..fefa06ea1 100644 --- a/src/Fable.Transforms/Global/Fable.Core.fs +++ b/src/Fable.Transforms/Global/Fable.Core.fs @@ -21,4 +21,3 @@ type CaseRules = type StringEnumAttribute() = inherit Attribute() new(caseRules: CaseRules) = StringEnumAttribute() - new(caseRules: CaseRules, respectValues: bool) = StringEnumAttribute() diff --git a/tests/Js/Main/JsInteropTests.fs b/tests/Js/Main/JsInteropTests.fs index 068e937b1..28fd18e5f 100644 --- a/tests/Js/Main/JsInteropTests.fs +++ b/tests/Js/Main/JsInteropTests.fs @@ -225,10 +225,17 @@ type LowerAllOptions = | ContentBox | BorderBox -[] +type RespectValuesEnum = Foo = 0 | Bar = 1 | Baz = 2 + +[] type RespectValues = | ContentBox | [] None + | [] AnswerToLife + | [] Pi + | [] Foo + | [] Bar +// | [] Undefined // Error: Expected: undefined - Actual: undefined [] #endif @@ -834,11 +841,15 @@ let tests = let x = LowerAllOptions.ContentBox x |> unbox |> equal "contentbox" - testCase "StringEnum works with RespectCompiledValue" <| fun () -> - let x = RespectValues.ContentBox - x |> unbox |> equal "contentbox" - let y = RespectValues.None - y |> unbox |> equal false + testCase "StringEnum is overwritten by CompiledValue" <| fun () -> + RespectValues.ContentBox |> unbox |> equal "contentbox" + RespectValues.None |> unbox |> equal false + RespectValues.Pi |> unbox |> equal 3.14159 + RespectValues.AnswerToLife |> unbox |> equal 42 + RespectValues.Foo |> unbox |> equal RespectValuesEnum.Foo + + testCase "StringEnum CompiledName over CompiledValue" <| fun () -> + RespectValues.Bar |> unbox |> equal "Bar" // See https://github.com/fable-compiler/fable-import/issues/72 testCase "Can use values and functions from global modules" <| fun () -> From 7ff2b085e78f29b3f1c248148032407be2ae2a2d Mon Sep 17 00:00:00 2001 From: cabboose Date: Tue, 24 Jun 2025 22:48:04 +0800 Subject: [PATCH 4/5] correct documentation link, better example/remarks code --- src/Fable.Core/Fable.Core.Types.fs | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/src/Fable.Core/Fable.Core.Types.fs b/src/Fable.Core/Fable.Core.Types.fs index bddfb73fe..7c255439c 100644 --- a/src/Fable.Core/Fable.Core.Types.fs +++ b/src/Fable.Core/Fable.Core.Types.fs @@ -100,11 +100,19 @@ type EmitPropertyAttribute(propertyName: string) = /// Compile union types as string literals. /// /// -/// Use the CompiledName or CompiledValue attributes on union fields to change -/// the generated values. +/// You can also use [<CompiledName>] and [<CompiledValue>] to +/// specify the name or literal of the union case in the generated code: +/// +/// [<StringEnum>] +/// type EventType = +/// | [<CompiledName("Abracadabra")>] MouseOver +/// | [<CompiledValue(false)>] RealMagic +/// let eventType = EventType.MouseOver // Compiles: "Abracadabra" +/// let magicPower = EventType.RealMagic // Compiles: false +/// /// -/// -/// Docs section on StringEnum +/// +/// Fable Documentation /// [] type StringEnumAttribute(caseRules: CaseRules) = From 9b261b95e4ea6ecc9512b3d04275a49bdc3568b7 Mon Sep 17 00:00:00 2001 From: Maxime Mangel Date: Wed, 25 Jun 2025 09:47:32 +0200 Subject: [PATCH 5/5] test: disable failing test when run against standalone --- tests/Js/Main/JsInteropTests.fs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/tests/Js/Main/JsInteropTests.fs b/tests/Js/Main/JsInteropTests.fs index 28fd18e5f..c0461d7c8 100644 --- a/tests/Js/Main/JsInteropTests.fs +++ b/tests/Js/Main/JsInteropTests.fs @@ -844,7 +844,11 @@ let tests = testCase "StringEnum is overwritten by CompiledValue" <| fun () -> RespectValues.ContentBox |> unbox |> equal "contentbox" RespectValues.None |> unbox |> equal false + // When running fable-compiler-js we can't make a distinction between int and float at runtime + // See https://github.com/fable-compiler/Fable/pull/4144#issuecomment-3001681838 + #if !NPM_PACKAGE_FABLE_COMPILER_JAVASCRIPT RespectValues.Pi |> unbox |> equal 3.14159 + #endif RespectValues.AnswerToLife |> unbox |> equal 42 RespectValues.Foo |> unbox |> equal RespectValuesEnum.Foo