From 28815c70b5d356c0e0ad90852406ee0c2d739ad0 Mon Sep 17 00:00:00 2001 From: cabboose Date: Fri, 5 Sep 2025 13:56:37 +0800 Subject: [PATCH 01/13] storybook base implementation --- .../Partas.Solid.FablePlugin.fsproj | 1 + Partas.Solid.FablePlugin/Storybook.fs | 778 ++++++++++++++++++ Partas.Solid.FablePlugin/Utils.fs | 101 +++ Partas.Solid/Partas.Solid.fsproj | 1 + Partas.Solid/Storybook.fs | 62 ++ 5 files changed, 943 insertions(+) create mode 100644 Partas.Solid.FablePlugin/Storybook.fs create mode 100644 Partas.Solid/Storybook.fs diff --git a/Partas.Solid.FablePlugin/Partas.Solid.FablePlugin.fsproj b/Partas.Solid.FablePlugin/Partas.Solid.FablePlugin.fsproj index c4732b7..11541fc 100644 --- a/Partas.Solid.FablePlugin/Partas.Solid.FablePlugin.fsproj +++ b/Partas.Solid.FablePlugin/Partas.Solid.FablePlugin.fsproj @@ -22,6 +22,7 @@ + diff --git a/Partas.Solid.FablePlugin/Storybook.fs b/Partas.Solid.FablePlugin/Storybook.fs new file mode 100644 index 0000000..cb400d3 --- /dev/null +++ b/Partas.Solid.FablePlugin/Storybook.fs @@ -0,0 +1,778 @@ +namespace Partas.Solid + +open System +open Fable +open Fable.AST +open Fable.AST.Fable +open Fable.AST.Fable.Expr +open Fable.AST.Fable.Patterns +open Partas.Solid.Baked +open System.Xml.Linq +open System.Xml.XPath + +[] +do () + +(* +Doc members +DefaultValue +Description = summary +*) +// Make a computation expression for rendering variants and the main + +/// +// Get docs off types +// get docs off members + +[] +type FieldType = + | Field of Field + | Member of MemberFunctionOrValue + member this.Type = + match this with + | Field field -> field.FieldType + | Member memb -> + if memb.IsSetter then + memb.CurriedParameterGroups + |> List.collect id + |> List.head + else + memb.ReturnParameter + |> _.Type + member this.XmlDocs = + match this with + | Field _ -> None + | Member memb -> + memb.XmlDoc + |> Option.bind (fun docs -> + if docs |> String.IsNullOrWhiteSpace then + None + else Some docs + ) + member this.Attributes = + match this with + | Field _ -> [] + | Member memb -> + memb.Attributes |> Seq.toList + member this.Name = + match this with + | Field field -> field.Name + | Member memb -> memb.DisplayName + +type ControlType = + | Object + | Boolean + | Check + | InlineCheck + | Radio + | InlineRadio + | Select + | MultiSelect + | Number + | Range + | File + | Color + | Date + | Text + override this.ToString() = + match this with + | Object -> "object" + | Boolean -> "boolean" + | Check -> "check" + | InlineCheck -> "inline-check" + | Radio -> "radio" + | InlineRadio -> "inline-radio" + | Select -> "select" + | MultiSelect -> "multi-select" + | Number -> "number" + | Range -> "range" + | File -> "file" + | Color -> "color" + | Date -> "date" + | Text -> "text" + +[] +module Utils = + type AstUtils with + static member TableInfo(?summary: string, ?detail: string) = + [ + if summary.IsSome then + "summary", summary.Value |> AstUtils.Value + if detail.IsSome then + "detail", detail.Value |> AstUtils.Value + ] |> AstUtils.Object + static member Table( + ?category: string, + ?defaultValueSummary: string, + ?defaultValueDetail: string, + ?disable: bool, + ?subcategory: string, + ?typSummary: string, + ?typDetail: string) = + [ + if category.IsSome then + "category", AstUtils.Value category.Value + if defaultValueDetail.IsSome || defaultValueSummary.IsSome then + "defaultValue", AstUtils.TableInfo(?summary = defaultValueSummary, ?detail = defaultValueDetail) + if disable.IsSome then + "disable", AstUtils.Value disable.Value + if typSummary.IsSome || typDetail.IsSome then + "type", AstUtils.TableInfo(?summary = typSummary, ?detail = typDetail) + if subcategory.IsSome then + "subcategory", AstUtils.Value subcategory.Value + ] |> AstUtils.Object + static member ControlType( + ?typ: ControlType, + ?accept: string, + // todo ? + ?labels: (string * string) list, + ?max: Expr, + ?min: Expr, + ?presetColors: string list, + ?step: Expr, + ?doNotRender: bool + ) = + let doNotRender = defaultArg doNotRender false + [ + if typ.IsSome && not doNotRender then + "type", AstUtils.Value(typ.Value.ToString()) + elif doNotRender then + "type", AstUtils.Value(false) + if accept.IsSome then + "accept", AstUtils.Value(accept.Value) + if labels.IsSome then + "labels", + labels.Value + |> List.map (snd >> AstUtils.Value) + |> List.zip (labels.Value |> List.map fst) + |> AstUtils.Object + if max.IsSome then + "max", max.Value + if min.IsSome then + "min", min.Value + if presetColors.IsSome then + "presetColors", + presetColors.Value + |> List.map AstUtils.Value + |> AstUtils.ValueArray + if step.IsSome then + "step", step.Value + + ] |> AstUtils.Object + static member ArgType( + ?control: Expr, + ?description: string, + ?conditional: Expr, + ?mapping: Expr, + ?name: string, + ?options: Expr list, + ?table: Expr, + ?typ: Expr) = + [ + if control.IsSome then "control", control.Value + if description.IsSome then "description", AstUtils.Value(description.Value) + if conditional.IsSome then "conditional", conditional.Value + if mapping.IsSome then "mapping", mapping.Value + if name.IsSome then "name", AstUtils.Value name.Value + if options.IsSome then "options", AstUtils.ValueArray options.Value + if table.IsSome then "table", table.Value + if typ.IsSome then "type", typ.Value + ] |> AstUtils.Object + static member Meta( + comp: Expr, + ?subComps: Expr list, + ?args: Expr, + ?argTypes: Expr, + ?render: Expr, + ?stories: string list, + ?parameters: Expr, + ?tags: string list + ) = + [ + "component", comp + if subComps.IsSome then "subcomponents", AstUtils.ValueArray subComps.Value + if args.IsSome then "args", args.Value + if argTypes.IsSome then "argTypes", argTypes.Value + if render.IsSome then "render", render.Value + if stories.IsSome then "stories", stories.Value |> List.map AstUtils.Value |> AstUtils.ValueArray + if parameters.IsSome then "parameters", parameters.Value + if tags.IsSome then "tags", tags.Value |> List.map AstUtils.Value |> AstUtils.ValueArray + ] |> AstUtils.Object +module internal rec StorybookTypeRecursion = + let (|EntityFullName|): DeclaredType -> string = _.Entity.FullName + /// Filter interfaces that are predefined as thats too much noise. + let (|FeedInterface|) (ctx: PluginContext): DeclaredType list -> DeclaredType list = function + | [] -> [] + | declaredType :: FeedInterface ctx rest -> + match declaredType with + | EntityFullName (StartsWith "Partas.Solid.Tags") -> + rest + | ent -> + ent :: rest + let filterMembers (ctx: PluginContext) (decls: MemberFunctionOrValue seq) = + decls + |> Seq.filter (fun memb -> + $"{memb.FullName} | {memb.ToString()}" + |> PluginContext.logWarning ctx + ( + memb.IsInline + || memb.IsInternal + || memb.IsPrivate + || memb.CurriedParameterGroups |> List.collect id |> List.length > 1 + ) |> not + && memb.IsSetter + ) + + let getFilteredMembers (ctx: PluginContext) (decl: DeclaredType) = + let entity = ctx.Helper.GetEntity decl.Entity + entity.MembersFunctionsAndValues + |> filterMembers ctx + + let getEntityInterfaces (ctx: PluginContext) (ent: Entity) = + ent.AllInterfaces + |> Seq.toList + |> function FeedInterface ctx interfaces -> interfaces + + let getEntity (ctx: PluginContext) (entityRef: DeclaredType) = + ctx.Helper.GetEntity entityRef.Entity + + let rec getEntityMembers (ctx: PluginContext) (entity: Entity) = + let getMembers = + entity.MembersFunctionsAndValues + |> filterMembers ctx + |> Seq.map FieldType.Member + |> Seq.toList + entity.BaseType + |> Option.map (getEntity ctx >> getEntityMembers ctx) + |> Option.defaultValue [] + |> List.append getMembers + let rec collectEntityFields (ctx: PluginContext) (ent: Entity) = + ent.BaseType + |> Option.map (getEntity ctx >> collectEntityFields ctx) + |> Option.defaultValue [] + |> List.append ent.FSharpFields + |> List.filter (_.Name.EndsWith('@') >> not) + + let (|GetGenericArg|) (ctx: PluginContext) = function + | GetDeclaredType (Type.DeclaredType(ref, _)) -> + ctx.Helper.GetEntity ref + | _ -> failwith "Incorrect AST structure. Different to expected." + + let rec collectEntityMembers (ctx: PluginContext) (entity: Entity) = + let baseAndEntityFields = collectEntityFields ctx entity |> List.map FieldType.Field + let interfaceMembers = + getEntityInterfaces ctx entity + |> Seq.collect (getFilteredMembers ctx) + |> Seq.map FieldType.Member + |> Seq.toList + let entityMembers = + getEntityMembers ctx entity + baseAndEntityFields @ interfaceMembers @ entityMembers + +module internal rec StorybookCases = + type CasesExpr = CasesExpr of Expr + type Cases = { + PropertyName: string + Cases: string list + } + let makeCases (ctx: PluginContext) (typ: Type) (CasesExpr caseExpr) = + let fieldExtractor: Expr -> string option = function + | Get(expr = IdentExpr { Type = identTyp }; kind = ( + GetKind.ExprGet(Value(kind = ValueKind.StringConstant(field))) + | GetKind.FieldGet( { Name = field } ) + )) when identTyp = typ -> + Some field + | _ -> None + let rec (|GetCases|): Expr -> string list = + function + | Expr.Call(callee = GetCases values; info = { Args = GetCases headValues :: exprs }) -> + values @ headValues @ (exprs |> List.collect (function GetCases values -> values)) + | Expr.CurriedApply(applied = GetCases values; args = exprs) -> + values @ (exprs |> List.collect (function GetCases values -> values)) + | Expr.DecisionTree(expr = GetCases values; targets = targets) -> + values @ (targets |> List.collect (snd >> function GetCases values -> values)) + | Expr.Delegate(body = GetCases values) -> values + | Expr.DecisionTreeSuccess(boundValues = exprs) -> + List.collect (function GetCases values -> values) exprs + | Expr.Get(expr = GetCases values; kind = kind) -> + match kind with + | ExprGet (GetCases values) -> values + | _ -> [] + @ values + | Expr.IfThenElse(guardExpr = GetCases values; elseExpr = GetCases elseValues; thenExpr = GetCases thenValues) -> + values @ elseValues @ thenValues + | Expr.Lambda(body = GetCases values) -> values + | Expr.Let(value = GetCases values; body = GetCases bodyValues) -> values @ bodyValues + | Expr.LetRec(bindings = exprs; body = GetCases values) -> + (exprs |> List.collect (snd >> function GetCases values -> values)) @ values + | Expr.ObjectExpr(baseCall = Some(GetCases values); members = members) -> + values @ (members |> List.collect (_.Body >> function GetCases memberValues -> memberValues) ) + | Expr.ObjectExpr(members = members) -> + members |> List.collect (_.Body >> function GetCases values -> values) + | Expr.Operation(kind = OperationKind.Binary(operator = BinaryOperator.BinaryEqual; right = Value(kind = StringConstant value); left = GetCases values)) -> + value :: values + | Expr.Operation(kind = OperationKind.Binary(operator = BinaryOperator.BinaryEqual; right = GetCases values; left = GetCases leftValues)) -> + leftValues @ values + | Expr.Sequential(exprs = exprs) -> + exprs |> List.collect (function GetCases values -> values) + | Expr.TypeCast(expr = GetCases values) -> values + | _ -> [] + let field = caseExpr |> findAndDiscardElse (fieldExtractor >> _.IsSome) |> List.choose fieldExtractor + field |> sprintf "%A" |> PluginContext.logWarning ctx + field |> List.map(fun fieldName -> { + PropertyName = fieldName + Cases = caseExpr + |> function GetCases values -> values } ) + + + let findMatchers (ctx: PluginContext) (expr: Expr list) = + let matcher = + findAndDiscardElse (function + | Let(ident = { Name = StartsWith("matchValue"); Type = Type.String }) -> true + | _ -> false + ) + expr |> List.collect matcher |> List.map CasesExpr + // |> fun values -> + // values |> sprintf "%A" + // |> PluginContext.logWarning ctx + // values + + let getCases (ctx: PluginContext) (entityTyp: Type) (expr: Expr) = + findMatchers ctx [expr] + |> List.collect (makeCases ctx entityTyp) + |> List.groupBy _.PropertyName + |> List.map (fun (key,cases) -> { + PropertyName = key + Cases = cases |> List.collect _.Cases |> List.distinct + } ) + +module internal rec StorybookVariantsAndArgs = + type RawVariantExpr = RawVariantExpr of variantName: string * expr: Expr + type Variant = Variant of variantName: string * args: (string * Expr) list + let getVariants (ctx: PluginContext) (expr: Expr) = + let predicate = function + | Expr.Sequential (TypeCast(expr = Value(kind = StringConstant (StartsWith "PARTAS_VARIANT"))) :: _ ) -> true + | _ -> false + let rec recursiveDiscovery expr = + findAndDiscardElse predicate expr + |> List.collect (function + | Expr.Sequential( _ :: exprs ) as expr -> + expr :: + (exprs + |> List.collect recursiveDiscovery) + | e -> [ e ] + ) + let extractVariantExprs = function + | Sequential (nameExpr :: (Sequential (TypeCast(expr = expr) :: _) :: _)) -> + let variantName = + match nameExpr with + | TypeCast(expr = Value(kind = StringConstant (StartsWithTrimmed "PARTAS_VARIANT" variantName))) -> Some variantName + | _ -> None + variantName |> Option.map (fun variantName -> RawVariantExpr(variantName, expr)) + | _ -> None + let processRawVariantExpr (RawVariantExpr(name,expr)) = + let predicate = function + | Set _ + | Call(callee = Import(info = { Kind = ImportKind.MemberImport (MemberRef(info = { CompiledName = StartsWith "set_" })) })) -> + true + | _ -> false + findAndDiscardElse predicate expr + |> List.choose (function + | Set(kind = SetKind.FieldSet propName; value = value) -> + Some(propName, value) + | Call( + callee = Import(info = { Kind = ImportKind.MemberImport (MemberRef(info = { CompiledName = StartsWithTrimmed "set_" prop }))}) + info = { Args = exprs } + ) -> + Some (prop, + if exprs.Length > 1 then + Sequential exprs + elif exprs.Length = 0 then + AstUtils.Unit + else exprs |> List.head) + | _ -> None + ) + |> fun args -> + Variant(name, args) + recursiveDiscovery expr + |> List.choose extractVariantExprs + |> List.map processRawVariantExpr + let getArgs (ctx: PluginContext) (expr: Expr) = + let predicate = function + | Lambda(name = Some(StartsWith "PARTAS_ARGS")) -> true + | _ -> false + let processRawVariantExpr expr = + let predicate = function + | Set _ + | Call(callee = Import(info = { Kind = ImportKind.MemberImport (MemberRef(info = { CompiledName = StartsWith "set_" })) })) -> + true + | _ -> false + findAndDiscardElse predicate expr + |> List.choose (function + | Set(kind = SetKind.FieldSet propName; value = value) -> + Some(propName, value) + | Call( + callee = Import(info = { Kind = ImportKind.MemberImport (MemberRef(info = { CompiledName = StartsWithTrimmed "set_" prop }))}) + info = { Args = exprs } + ) -> + Some (prop, + if exprs.Length > 1 then + Sequential exprs + elif exprs.Length = 0 then + AstUtils.Unit + else exprs |> List.head) + | _ -> None + ) + findAndDiscardElse predicate expr + |> List.collect processRawVariantExpr + |> AstUtils.Object + +module internal StorybookAST = + let getComponentExprFromEntity (ctx: PluginContext) (entity: Entity) = + let name = entity.DisplayName + let entRef = entity.Ref + if entRef.SourcePath |> Option.exists ((=) ctx.Helper.CurrentFile) then + AstUtils.IdentExpr(name) + else + AstUtils.Import(name, entRef.SourcePath |> Option.defaultValue "", entRef) + + + let createUnionExprs(ctx: PluginContext) (entity: Entity) = + let cases = + if not entity.IsFSharpUnion then None + else + Some entity.UnionCases + cases + |> Option.map( + List.mapi (fun idx case -> + Expr.Value(ValueKind.NewUnion([], idx, entity.Ref, []), None) + ) + ) + let createStringEnumExprArray (ctx: PluginContext) (values: string list) = + values |> List.map AstUtils.Value |> AstUtils.ValueArray + let private extractElementValue elementName: XDocument -> _ = + _.XPathSelectElement($"//{elementName}") + >> Option.ofObj + >> Option.map (_.Value.Trim()) + + type MetaExpr = + | ArgType of string * Expr + | Arg of string * Expr + + let createMeta (ctx: PluginContext) (expr: Expr) = + let typ = + match expr with + | Call(typ = DeclaredType(_, GetDeclaredType typ :: _)) -> typ + | _ -> failwith $"CreateMeta: Unexpected expr -> {expr}" + let entity = + match typ with + | StorybookTypeRecursion.GetGenericArg ctx entity -> + entity + let predefinedCases = StorybookCases.getCases ctx typ expr + let properties = StorybookTypeRecursion.collectEntityMembers ctx entity + let args = StorybookVariantsAndArgs.getArgs ctx expr + let variants = StorybookVariantsAndArgs.getVariants ctx expr + let argTypes = + properties |> List.map (fun prop -> + let docs = prop.XmlDocs |> Option.map (fun docs -> + let normalizedDocs = "" + docs + "" + let read value = + use reader = new System.IO.StringReader(value) + XDocument.Load(reader) + let docs = read normalizedDocs + docs + ) + let getElementValue value = docs |> Option.bind (extractElementValue value) + let description = getElementValue "summary" + let defaultValue = getElementValue "defaultValue" + let options = + predefinedCases |> List.tryFind (_.PropertyName >> (=) prop.Name) |> Option.map _.Cases + let rec makeArgType typ = + match typ with + | Any -> + let control = AstUtils.ControlType(typ = ControlType.Object) + AstUtils.ArgType( + control = control, + table = AstUtils.Table(?defaultValueSummary = defaultValue), + ?description = description + ) + | Type.Boolean -> + let control = AstUtils.ControlType(typ = ControlType.Boolean) + AstUtils.ArgType( + control = control, + table = AstUtils.Table(?defaultValueSummary = defaultValue), + ?description = description + ) + | Char -> + let control = AstUtils.ControlType(typ = ControlType.Text) + AstUtils.ArgType( + control = control, + table = AstUtils.Table(typSummary = "Char", typDetail = "Single length text", ?defaultValueSummary = defaultValue), + ?description = description + ) + | String -> + match options with + | Some values -> + let control = AstUtils.ControlType( + typ = + if values.Length < 6 then ControlType.Radio + else ControlType.Select + ) + AstUtils.ArgType( + control = control, + table = AstUtils.Table(?defaultValueSummary = defaultValue), + options = (values |> List.map AstUtils.Value), + ?description = description + ) + | None -> + let control = AstUtils.ControlType(typ = ControlType.Text) + AstUtils.ArgType( + control = control, + table = AstUtils.Table(?defaultValueSummary = defaultValue), + ?description = description + ) + | Regex -> + let control = + AstUtils.ControlType(typ = ControlType.Text) + AstUtils.ArgType( + control = control, + table = AstUtils.Table( + typSummary = "Regex", + typDetail = "Expects valid regex", + ?defaultValueSummary = defaultValue + ), + ?description = description + ) + // todo - support enums + | Type.Number (kind, info) -> + let control = + match kind with + | Int8 -> + AstUtils.ControlType( + typ = ControlType.Number, + max = AstUtils.Value(int System.SByte.MaxValue), + min = AstUtils.Value(int System.SByte.MinValue), + step = AstUtils.Value(1)) + | UInt8 -> + AstUtils.ControlType( + typ = ControlType.Number, + max = AstUtils.Value(int System.Byte.MaxValue), + min = AstUtils.Value(0), + step = AstUtils.Value(1) + ) + | Int16 -> + AstUtils.ControlType( + typ = ControlType.Number, + max = AstUtils.Value(int System.Int16.MaxValue), + min = AstUtils.Value(int System.Int16.MinValue), + step = AstUtils.Value(1) + ) + | UInt16 -> + AstUtils.ControlType( + typ = ControlType.Number, + max = AstUtils.Value(int System.UInt16.MaxValue), + min = AstUtils.Value(int System.UInt16.MinValue), + step = AstUtils.Value(1) + ) + | UInt64 -> + AstUtils.ControlType( + typ = ControlType.Number, + min = AstUtils.Value(0), + step = AstUtils.Value(1) + ) + | UNativeInt | UInt128 -> + AstUtils.ControlType(typ = ControlType.Number, step = AstUtils.Value(1), min = AstUtils.Value(0)) + | Int128 | NativeInt | Int64 | BigInt -> + AstUtils.ControlType(typ = ControlType.Number, step = AstUtils.Value(1)) + | Float16 | Float32 -> + AstUtils.ControlType( + typ = ControlType.Number, + max = AstUtils.Value(float System.Single.MaxValue), + min = AstUtils.Value(float System.Single.MinValue) + ) + | Float64 | Decimal -> + AstUtils.ControlType( typ = ControlType.Number ) + | Int32 -> + AstUtils.ControlType( + typ = ControlType.Number, + max = AstUtils.Value(int System.Int32.MaxValue), + min = AstUtils.Value(int System.Int32.MinValue), + step = AstUtils.Value(1) + ) + | UInt32 -> + AstUtils.ControlType( + typ = ControlType.Number, + max = AstUtils.Value(int System.UInt32.MaxValue), + min = AstUtils.Value(0), + step = AstUtils.Value(1) + ) + + AstUtils.ArgType( + control = control, + table = AstUtils.Table( + typSummary = kind.ToString(), + ?defaultValueSummary = defaultValue + ), + ?description = description + ) + | Tuple (genArg, _) -> + let tupleTyping = + genArg |> List.map _.ToString() |> String.concat ", " + |> sprintf "Tuple ( %s )" + let control = AstUtils.ControlType(typ = ControlType.Object) + AstUtils.ArgType( + control = control, + table = AstUtils.Table( + typSummary = tupleTyping, + ?defaultValueSummary = defaultValue + ), + ?description = description + ) + | List genArg + | Array (genArg, _) -> + let arrayTyping = genArg.ToString() |> sprintf "Array of %s" + let control = AstUtils.ControlType(typ = ControlType.Object) + AstUtils.ArgType( + control = control, + table = AstUtils.Table( + typSummary = arrayTyping, + ?defaultValueSummary = defaultValue + ), + ?description = description + ) + | Nullable (genArg, _) | Option (genArg, _) -> makeArgType genArg + | LambdaType _ | DelegateType _ -> + let control = AstUtils.ControlType(doNotRender = true) + AstUtils.ArgType( + control = control, + table = AstUtils.Table( + typSummary = "function", + ?defaultValueSummary = defaultValue + ), + ?description = description + ) + | GenericParam (name, isMeasure, constraints) -> + let control = AstUtils.ControlType(doNotRender = true) + AstUtils.ArgType( + control = control, + table = AstUtils.Table( + typSummary = $"GenericParam {name}", + ?defaultValueSummary = defaultValue + ), + ?description = description + ) + | DeclaredType (ref, genArgs) -> + let entity = ctx.Helper.GetEntity ref + if entity.IsFSharpRecord then + let typName = + entity.FSharpFields + |> List.map (fun field -> + $"{field.Name}: {field.FieldType}" + ) + |> String.concat ", " + |> sprintf "{ %s }" + let control = AstUtils.ControlType(typ = ControlType.Object) + AstUtils.ArgType( + control = control, + table = AstUtils.Table( + typSummary = "Object", + typDetail = typName, + ?defaultValueSummary = defaultValue + ), + ?description = description + ) + // elif entity.IsFSharpUnion then + // TODO + else + let control = AstUtils.ControlType(typ = ControlType.Object) + AstUtils.ArgType( + control = control, + table = AstUtils.Table( + typSummary = ref.DisplayName, + ?typDetail = ref.SourcePath, + ?defaultValueSummary = defaultValue + ), + ?description = description + ) + | AnonymousRecordType (fieldNames, genArgs, isStruct) -> + let control = AstUtils.ControlType(typ = ControlType.Object) + let typName = + fieldNames |> Array.toList + |> List.zip genArgs + |> List.map(function + | typ,name -> + $"{name}: {typ}" + ) + |> String.concat ", " + |> sprintf "{ %s }" + AstUtils.ArgType( + control = control, + table = AstUtils.Table( + typSummary = "Object", + typDetail = typName, + ?defaultValueSummary = defaultValue + ), + ?description = description + ) + | _ -> AstUtils.Unit + // | _ -> () + let argType = + makeArgType prop.Type + |> fun expr -> prop.Name, expr + // [ MetaExpr.ArgType argType ] + makeArgType prop.Type + |> fun expr -> + prop.Name, expr + ) + [ + "component", getComponentExprFromEntity ctx entity + "args", args + "argTypes", AstUtils.Object argTypes + ] |> AstUtils.Object + , variants + // , () + + [] + let rec (|RootExpr|_|) ctx = function + | Call(callee=(Import(info = { Selector = StartsWith "StorybookExtensions_Run" }))) as expr -> + ValueSome expr + | _ -> ValueNone + + let getRoot (ctx: PluginContext) expr = + let predicate = function RootExpr ctx _ -> true | _ -> false + findAndDiscardElse predicate expr + |> function + | [ expr ]-> + createMeta ctx expr + + | _ -> failwith $"Unexpected content {expr}" + + let rec transform ctx = function + // | RootExpr ctx expr -> expr + | expr -> expr |> getRoot ctx + +[] +type PartasStorybookAttribute(compFlags: int) = + inherit MemberDeclarationPluginAttribute() + let flags = enum compFlags + override this.Transform(pluginHelper, file, memberDecl) = + let ctx = PluginContext.create pluginHelper TransformationKind.MemberDecl flags + memberDecl |> printfn "%A" + memberDecl.Body + |> StorybookAST.transform ctx + |> fun e -> + snd e |> sprintf "%A" |> PluginContext.logWarning ctx + { memberDecl with Body = fst e } + // |> printfn "%A" + // |> printfn "%A" + // memberDecl + // |> fun newExpr -> + // newExpr |> printfn "%A" + // { memberDecl with Body = newExpr } + + override this.TransformCall(_, _, expr) = + expr + + override this.FableMinimumVersion = "5.0" + new() = PartasStorybookAttribute(int ComponentFlag.Default) + new(componentFlag: ComponentFlag) = PartasStorybookAttribute(int componentFlag) diff --git a/Partas.Solid.FablePlugin/Utils.fs b/Partas.Solid.FablePlugin/Utils.fs index 25d9b27..b734159 100644 --- a/Partas.Solid.FablePlugin/Utils.fs +++ b/Partas.Solid.FablePlugin/Utils.fs @@ -382,6 +382,107 @@ module Patterns = | _ -> None +module Expr = + let rec findAndDiscardElse (predicate: Expr -> bool): Expr -> Expr list = + let filterList (values: Expr list): Expr list = + List.collect (findAndDiscardElse predicate) values + function + | expr when predicate expr -> [ expr ] + | Expr.Call(callee = expr; info = { Args = exprs }) -> + expr :: exprs + |> filterList + | Expr.CurriedApply(applied= expr; args = exprs) -> + expr :: exprs + |> filterList + | Expr.DecisionTree(expr=expr; targets = targets) -> + expr :: List.map snd targets + |> filterList + | Expr.DecisionTreeSuccess(boundValues = exprs) -> + filterList exprs + | Expr.Delegate(body = expr) -> + findAndDiscardElse predicate expr + | Expr.Emit(info = { CallInfo = { Args = exprs } }) -> + filterList exprs + | Expr.ForLoop(start = start; body = body; limit = limit) -> + [ start; body; limit ] + |> filterList + | Expr.Get(expr = expr; kind = getKind) -> + let maybeResult = findAndDiscardElse predicate expr + if maybeResult.IsEmpty |> not then maybeResult + else + match getKind with + | ExprGet expr -> + findAndDiscardElse predicate expr + | _ -> maybeResult + | Expr.IfThenElse(guardExpr = guardExpr; elseExpr = elseExpr; thenExpr = thenExpr) -> + [ guardExpr; elseExpr; thenExpr ] + |> filterList + | Expr.Lambda(body = expr) -> + findAndDiscardElse predicate expr + | Expr.Let(body = body; value = value) -> + filterList [ body; value ] + | Expr.LetRec(bindings = bindings; body = body) -> + body :: List.map snd bindings + |> filterList + | Expr.ObjectExpr(baseCall = exprMaybe; members = members) -> + members |> List.map _.Body + |> List.append [ if exprMaybe.IsSome then exprMaybe.Value ] + |> filterList + | Expr.Operation(kind = OperationKind.Binary(left = left; right = right)) + | Expr.Operation(kind = OperationKind.Logical(left = left; right = right)) -> + [ left; right ] + |> filterList + | Expr.Operation(kind = OperationKind.Unary(operand = expr)) -> + findAndDiscardElse predicate expr + | Expr.Sequential exprs -> + filterList exprs + | Expr.Set(expr = expr; value = value; kind = kind) -> + match kind with + | ExprSet exprSet -> + [ expr; value; exprSet ] + |> filterList + | _ -> [ expr;value ] |> filterList + | Expr.TryCatch(body = expr; catch = catch; finalizer = finalizer) -> + [ + expr + match catch with + | Some(_,value) -> value + | _ -> () + match finalizer with + | Some value -> value + | _ -> () + ] + |> filterList + | Expr.TypeCast(expr = expr) -> findAndDiscardElse predicate expr + | Expr.Value(kind = kind) -> + match kind with + | ValueKind.NewAnonymousRecord(values = exprs) -> + filterList exprs + | NewArray(newKind = NewArrayKind.ArrayAlloc expr) -> + findAndDiscardElse predicate expr + | NewArray(newKind = NewArrayKind.ArrayFrom expr) -> + findAndDiscardElse predicate expr + | NewArray(newKind = NewArrayKind.ArrayValues exprs) -> + filterList exprs + | NewList(headAndTail = Some (head,tail)) -> + [ head; tail ] + |> filterList + | NewOption(value = Some expr) -> + findAndDiscardElse predicate expr + | NewTuple(values = exprs) + | NewUnion(values = exprs) + | StringTemplate(values = exprs; tag = None) + | NewRecord(values = exprs) -> + filterList exprs + | StringTemplate(values = exprs; tag = Some expr) -> + expr :: exprs + |> filterList + | _ -> [] + | Expr.WhileLoop(body = body; guard = guard) -> + [ guard; body ] + |> filterList + | _ -> [] + type StringUtils = /// Trims JS reserved identifiers such as `'` and ``#` where # is some number diff --git a/Partas.Solid/Partas.Solid.fsproj b/Partas.Solid/Partas.Solid.fsproj index 9066790..e8a21d0 100644 --- a/Partas.Solid/Partas.Solid.fsproj +++ b/Partas.Solid/Partas.Solid.fsproj @@ -36,6 +36,7 @@ + diff --git a/Partas.Solid/Storybook.fs b/Partas.Solid/Storybook.fs new file mode 100644 index 0000000..f43d1af --- /dev/null +++ b/Partas.Solid/Storybook.fs @@ -0,0 +1,62 @@ +namespace Partas.Solid.Storybook + +open System.Runtime.CompilerServices +open Fable.Core + +#nowarn 49 + +[] +module Builder = + type Storybook<'T> = interface end + type StorybookArgs<'T> = interface end + type StorybookFun<'T> = Storybook<'T> -> unit + type StorybookArgsFun<'T> = StorybookArgs<'T> -> unit + type Storybook<'T> with + member inline _.Combine([] PARTAS_FIRST: StorybookFun<'T>, [] PARTAS_SECOND: StorybookFun<'T>): StorybookFun<'T> = + fun PARTAS_BUILDER -> + PARTAS_FIRST PARTAS_BUILDER + PARTAS_SECOND PARTAS_BUILDER + member inline _.Zero(): StorybookFun<'T> = ignore + member inline _.Yield(_: unit): StorybookFun<'T> = ignore + member inline _.Delay([] PARTAS_DELAY: unit -> StorybookFun<'T>): StorybookFun<'T> = PARTAS_DELAY() + member inline _.Yield([] PARTAS_ELEMENT: 'T -> 'Value): StorybookFun<'T> = fun PARTAS_YIELD -> ignore PARTAS_ELEMENT + member inline _.Yield(PARTAS_VALUE: StorybookArgs<'T>): StorybookFun<'T> = fun PARTAS_YIELD -> ignore PARTAS_VALUE + [] + member inline _.Cases([] PARTAS_FIRST: StorybookFun<'T>, PARTAS_CASES: ('T -> obj)): StorybookFun<'T> = fun PARTAS_BUILDER -> + ignore PARTAS_CASES + PARTAS_FIRST PARTAS_BUILDER + [] + member inline _.Args([] PARTAS_FIRST: StorybookFun<'T>, [] PARTAS_ARGS: ('T -> unit)): StorybookFun<'T> = fun PARTAS_BUILDER -> + ignore PARTAS_ARGS + PARTAS_FIRST PARTAS_BUILDER + [] + member inline _.Args([] PARTAS_FIRST: StorybookFun<'T>, PARTAS_VARIANT: string, [] PARTAS_VARIANT_ARGS: ('T -> unit)): StorybookFun<'T> = fun PARTAS_BUILDER -> + ignore ("PARTAS_VARIANT" + PARTAS_VARIANT) + ignore PARTAS_VARIANT_ARGS + PARTAS_FIRST PARTAS_BUILDER + member inline _.For([] PARTAS_FIRST: StorybookFun<'T>, [] PARTAS_SECOND: unit -> StorybookFun<'T>): StorybookFun<'T> = + fun PARTAS_BUILDER -> + PARTAS_FIRST PARTAS_BUILDER + PARTAS_SECOND () PARTAS_BUILDER + + type StorybookArgs<'T> with + member inline _.Combine([] PARTAS_FIRST: StorybookArgsFun<'T>, [] PARTAS_SECOND: StorybookArgsFun<'T>): StorybookArgsFun<'T> = + fun PARTAS_BUILDER -> + PARTAS_FIRST PARTAS_BUILDER + PARTAS_SECOND PARTAS_BUILDER + member inline _.Zero(): StorybookArgsFun<'T> = ignore + member inline _.Delay([] PARTAS_DELAY: unit -> StorybookArgsFun<'T>): StorybookArgsFun<'T> = PARTAS_DELAY() + member inline _.Yield(PARTAS_VALUE: ('T -> 'Value) * ('Value)): StorybookArgsFun<'T> = fun PARTAS_YIELD -> ignore PARTAS_VALUE + + type StorybookExtensions = + [] + static member Run(PARTAS_THIS: Storybook<'T>, PARTAS_RUN: StorybookFun<'T>) = + PARTAS_RUN PARTAS_THIS + PARTAS_THIS + [] + static member Run(PARTAS_THIS: StorybookArgs<'T>, PARTAS_RUN: StorybookArgsFun<'T>) = + PARTAS_RUN PARTAS_THIS + PARTAS_THIS + + let storybook<'T> = Unchecked.defaultof> + let args<'T> = Unchecked.defaultof> From 64a2c0862be7adcc9152ccc7bb500182f04104ff Mon Sep 17 00:00:00 2001 From: cabboose Date: Fri, 5 Sep 2025 15:01:54 +0800 Subject: [PATCH 02/13] alpha version storybook --- Partas.Solid.FablePlugin/Storybook.fs | 101 ++++++++++++++++++++------ Partas.Solid/Storybook.fs | 6 +- 2 files changed, 82 insertions(+), 25 deletions(-) diff --git a/Partas.Solid.FablePlugin/Storybook.fs b/Partas.Solid.FablePlugin/Storybook.fs index cb400d3..83f7a8f 100644 --- a/Partas.Solid.FablePlugin/Storybook.fs +++ b/Partas.Solid.FablePlugin/Storybook.fs @@ -346,6 +346,15 @@ module internal rec StorybookCases = Cases = cases |> List.collect _.Cases |> List.distinct } ) +module internal rec StorybookRender = + let getRender (ctx: PluginContext) (expr: Expr) = + let predicate = function + | Lambda(name = Some (StartsWith "PARTAS_RENDER")) -> true + | _ -> false + findAndDiscardElse predicate expr + |> List.tryHead + |> Option.map (AST.transform ctx) + module internal rec StorybookVariantsAndArgs = type RawVariantExpr = RawVariantExpr of variantName: string * expr: Expr type Variant = Variant of variantName: string * args: (string * Expr) list @@ -372,8 +381,13 @@ module internal rec StorybookVariantsAndArgs = | _ -> None let processRawVariantExpr (RawVariantExpr(name,expr)) = let predicate = function - | Set _ - | Call(callee = Import(info = { Kind = ImportKind.MemberImport (MemberRef(info = { CompiledName = StartsWith "set_" })) })) -> + | Set _ -> true + | Call(callee = Import(info = { Kind = ImportKind.MemberImport (MemberRef(info = { CompiledName = compiledName })) })) + when + compiledName + |> _.Split('.') + |> Array.last + |> _.StartsWith("set_") -> true | _ -> false findAndDiscardElse predicate expr @@ -381,9 +395,17 @@ module internal rec StorybookVariantsAndArgs = | Set(kind = SetKind.FieldSet propName; value = value) -> Some(propName, value) | Call( - callee = Import(info = { Kind = ImportKind.MemberImport (MemberRef(info = { CompiledName = StartsWithTrimmed "set_" prop }))}) + callee = Import(info = { Kind = ImportKind.MemberImport (MemberRef(info = { CompiledName = compiledName }))}) info = { Args = exprs } - ) -> + ) + when + compiledName.Split('.') + |> Array.last + |> _.StartsWith("set_") -> + let prop = + compiledName.Split('.') + |> Array.last + |> function StartsWithTrimmed "set_" value -> value | _ -> failwith "Unreachable" Some (prop, if exprs.Length > 1 then Sequential exprs @@ -403,8 +425,13 @@ module internal rec StorybookVariantsAndArgs = | _ -> false let processRawVariantExpr expr = let predicate = function - | Set _ - | Call(callee = Import(info = { Kind = ImportKind.MemberImport (MemberRef(info = { CompiledName = StartsWith "set_" })) })) -> + | Set _ -> true + | Call(callee = Import(info = { Kind = ImportKind.MemberImport (MemberRef(info = { CompiledName = compiledName })) })) + when + compiledName + |> _.Split('.') + |> Array.last + |> _.StartsWith("set_") -> true | _ -> false findAndDiscardElse predicate expr @@ -412,9 +439,17 @@ module internal rec StorybookVariantsAndArgs = | Set(kind = SetKind.FieldSet propName; value = value) -> Some(propName, value) | Call( - callee = Import(info = { Kind = ImportKind.MemberImport (MemberRef(info = { CompiledName = StartsWithTrimmed "set_" prop }))}) + callee = Import(info = { Kind = ImportKind.MemberImport (MemberRef(info = { CompiledName = compiledName }))}) info = { Args = exprs } - ) -> + ) + when + compiledName.Split('.') + |> Array.last + |> _.StartsWith("set_") -> + let prop = + compiledName.Split('.') + |> Array.last + |> function StartsWithTrimmed "set_" value -> value | _ -> failwith "Unreachable" Some (prop, if exprs.Length > 1 then Sequential exprs @@ -427,6 +462,8 @@ module internal rec StorybookVariantsAndArgs = |> List.collect processRawVariantExpr |> AstUtils.Object +open StorybookVariantsAndArgs + module internal StorybookAST = let getComponentExprFromEntity (ctx: PluginContext) (entity: Entity) = let name = entity.DisplayName @@ -459,7 +496,7 @@ module internal StorybookAST = | ArgType of string * Expr | Arg of string * Expr - let createMeta (ctx: PluginContext) (expr: Expr) = + let createMeta (ctx: PluginContext) (memberDecl: MemberDecl) (expr: Expr)= let typ = match expr with | Call(typ = DeclaredType(_, GetDeclaredType typ :: _)) -> typ @@ -472,6 +509,7 @@ module internal StorybookAST = let properties = StorybookTypeRecursion.collectEntityMembers ctx entity let args = StorybookVariantsAndArgs.getArgs ctx expr let variants = StorybookVariantsAndArgs.getVariants ctx expr + let render = StorybookRender.getRender ctx expr let argTypes = properties |> List.map (fun prop -> let docs = prop.XmlDocs |> Option.map (fun docs -> @@ -715,21 +753,38 @@ module internal StorybookAST = ?description = description ) | _ -> AstUtils.Unit - // | _ -> () - let argType = - makeArgType prop.Type - |> fun expr -> prop.Name, expr - // [ MetaExpr.ArgType argType ] makeArgType prop.Type |> fun expr -> prop.Name, expr ) + let closeLastTemplate = "\nconst $PARTAS_DISCARD = { $discard: true" + let compExpr = + AstUtils.Emit( + [ + $"$0\n }};\n\nexport default {memberDecl.Name};\n" + yield! (variants |> List.mapi (fun idx (Variant(name,_)) -> + $"export const {name} = ${idx + 2}" ) ) + closeLastTemplate + ] |> String.concat "\n", + AstUtils.CallInfo(args = [ + getComponentExprFromEntity ctx entity + AstUtils.Value memberDecl.Name + yield! ( + variants |> List.map (fun (Variant (_,expr)) -> + AstUtils.Object([ + "args", AstUtils.Object(expr) + ]) + ) + ) + ]) + ) [ - "component", getComponentExprFromEntity ctx entity "args", args "argTypes", AstUtils.Object argTypes + if render.IsSome then + "render", render.Value + "component", compExpr ] |> AstUtils.Object - , variants // , () [] @@ -738,18 +793,16 @@ module internal StorybookAST = ValueSome expr | _ -> ValueNone - let getRoot (ctx: PluginContext) expr = + let transform (ctx: PluginContext) (memberDecl: MemberDecl) = let predicate = function RootExpr ctx _ -> true | _ -> false + let expr = memberDecl.Body findAndDiscardElse predicate expr |> function | [ expr ]-> - createMeta ctx expr + createMeta ctx memberDecl expr | _ -> failwith $"Unexpected content {expr}" - let rec transform ctx = function - // | RootExpr ctx expr -> expr - | expr -> expr |> getRoot ctx [] type PartasStorybookAttribute(compFlags: int) = @@ -758,11 +811,11 @@ type PartasStorybookAttribute(compFlags: int) = override this.Transform(pluginHelper, file, memberDecl) = let ctx = PluginContext.create pluginHelper TransformationKind.MemberDecl flags memberDecl |> printfn "%A" - memberDecl.Body + memberDecl |> StorybookAST.transform ctx |> fun e -> - snd e |> sprintf "%A" |> PluginContext.logWarning ctx - { memberDecl with Body = fst e } + { memberDecl with Body = e } + // snd e |> sprintf "%A" |> PluginContext.logWarning ctx // |> printfn "%A" // |> printfn "%A" // memberDecl diff --git a/Partas.Solid/Storybook.fs b/Partas.Solid/Storybook.fs index f43d1af..cc51b4d 100644 --- a/Partas.Solid/Storybook.fs +++ b/Partas.Solid/Storybook.fs @@ -38,7 +38,11 @@ module Builder = fun PARTAS_BUILDER -> PARTAS_FIRST PARTAS_BUILDER PARTAS_SECOND () PARTAS_BUILDER - + [] + member inline _.Render([] PARTAS_FIRST: StorybookFun<'T>, [] PARTAS_RENDER: 'T -> #Partas.Solid.Builder.HtmlElement): StorybookFun<'T> = + fun PARTAS_BUILDER -> + ignore PARTAS_RENDER + PARTAS_FIRST PARTAS_BUILDER type StorybookArgs<'T> with member inline _.Combine([] PARTAS_FIRST: StorybookArgsFun<'T>, [] PARTAS_SECOND: StorybookArgsFun<'T>): StorybookArgsFun<'T> = fun PARTAS_BUILDER -> From 4dcf0aa413a0a09a00787900a3a66ad69469e07d Mon Sep 17 00:00:00 2001 From: cabboose Date: Fri, 5 Sep 2025 22:06:24 +0800 Subject: [PATCH 03/13] doc extensions, member val string enum matching, et al --- .../Partas.Solid.FablePlugin.fsproj | 4 +- Partas.Solid.FablePlugin/Storybook.fs | 233 +++++++++++++----- Partas.Solid/Partas.Solid.fsproj | 4 +- 3 files changed, 175 insertions(+), 66 deletions(-) diff --git a/Partas.Solid.FablePlugin/Partas.Solid.FablePlugin.fsproj b/Partas.Solid.FablePlugin/Partas.Solid.FablePlugin.fsproj index 11541fc..c554d96 100644 --- a/Partas.Solid.FablePlugin/Partas.Solid.FablePlugin.fsproj +++ b/Partas.Solid.FablePlugin/Partas.Solid.FablePlugin.fsproj @@ -13,8 +13,8 @@ MIT Shayan Habibi based on work by Vladimir Schur and contributors Copyright (c) Shayan Habibi 2025 - 2.0.1 - 2.0.1 + 2.1.0-alpha.3 + 2.1.0-alpha.3 diff --git a/Partas.Solid.FablePlugin/Storybook.fs b/Partas.Solid.FablePlugin/Storybook.fs index 83f7a8f..b9e4801 100644 --- a/Partas.Solid.FablePlugin/Storybook.fs +++ b/Partas.Solid.FablePlugin/Storybook.fs @@ -13,19 +13,8 @@ open System.Xml.XPath [] do () -(* -Doc members -DefaultValue -Description = summary -*) -// Make a computation expression for rendering variants and the main - -/// -// Get docs off types -// get docs off members - [] -type FieldType = +type internal FieldType = | Field of Field | Member of MemberFunctionOrValue member this.Type = @@ -59,7 +48,7 @@ type FieldType = | Field field -> field.Name | Member memb -> memb.DisplayName -type ControlType = +type internal ControlType = | Object | Boolean | Check @@ -90,9 +79,26 @@ type ControlType = | Color -> "color" | Date -> "date" | Text -> "text" + /// Defaults to Object if fails to match + static member Parse(value: string) = + match value.ToLower() with + | "boolean" | "bool" -> Boolean + | "check" -> Check + | "inline-check" | "inlinecheck" -> InlineCheck + | "radio" -> Radio + | "inline-radio" | "inlineradio" -> InlineRadio + | "select" -> Select + | "multi-select" | "multiselect" -> MultiSelect + | "number" | "int" | "float" -> Number + | "range" -> Range + | "file" -> File + | "color" | "colour" -> Color + | "date" | "datetime" -> Date + | "text" | "string" -> Text + | _ -> Object [] -module Utils = +module internal Utils = type AstUtils with static member TableInfo(?summary: string, ?detail: string) = [ @@ -209,11 +215,9 @@ module internal rec StorybookTypeRecursion = rest | ent -> ent :: rest - let filterMembers (ctx: PluginContext) (decls: MemberFunctionOrValue seq) = + let private filterMembers (ctx: PluginContext) (decls: MemberFunctionOrValue seq) = decls |> Seq.filter (fun memb -> - $"{memb.FullName} | {memb.ToString()}" - |> PluginContext.logWarning ctx ( memb.IsInline || memb.IsInternal @@ -223,20 +227,20 @@ module internal rec StorybookTypeRecursion = && memb.IsSetter ) - let getFilteredMembers (ctx: PluginContext) (decl: DeclaredType) = + let private getFilteredMembers (ctx: PluginContext) (decl: DeclaredType) = let entity = ctx.Helper.GetEntity decl.Entity entity.MembersFunctionsAndValues |> filterMembers ctx - let getEntityInterfaces (ctx: PluginContext) (ent: Entity) = + let private getEntityInterfaces (ctx: PluginContext) (ent: Entity) = ent.AllInterfaces |> Seq.toList |> function FeedInterface ctx interfaces -> interfaces - let getEntity (ctx: PluginContext) (entityRef: DeclaredType) = + let private getEntity (ctx: PluginContext) (entityRef: DeclaredType) = ctx.Helper.GetEntity entityRef.Entity - let rec getEntityMembers (ctx: PluginContext) (entity: Entity) = + let rec private getEntityMembers (ctx: PluginContext) (entity: Entity) = let getMembers = entity.MembersFunctionsAndValues |> filterMembers ctx @@ -246,7 +250,7 @@ module internal rec StorybookTypeRecursion = |> Option.map (getEntity ctx >> getEntityMembers ctx) |> Option.defaultValue [] |> List.append getMembers - let rec collectEntityFields (ctx: PluginContext) (ent: Entity) = + let rec private collectEntityFields (ctx: PluginContext) (ent: Entity) = ent.BaseType |> Option.map (getEntity ctx >> collectEntityFields ctx) |> Option.defaultValue [] @@ -275,13 +279,17 @@ module internal rec StorybookCases = PropertyName: string Cases: string list } - let makeCases (ctx: PluginContext) (typ: Type) (CasesExpr caseExpr) = + let private makeCases (ctx: PluginContext) (typ: Type) (CasesExpr caseExpr) = let fieldExtractor: Expr -> string option = function | Get(expr = IdentExpr { Type = identTyp }; kind = ( GetKind.ExprGet(Value(kind = ValueKind.StringConstant(field))) | GetKind.FieldGet( { Name = field } ) )) when identTyp = typ -> Some field + | Call(callee=Import(typ = LambdaType(argType = typInfo); info = { Kind = MemberImport(MemberRef(_, { CompiledName = compiledName })) })) when typ = typInfo -> + compiledName.Split('.') |> Array.last + |> function StartsWithTrimmed "get_" value -> value |> StringUtils.TrimReservedIdentifiers |> Some + | _ -> None | _ -> None let rec (|GetCases|): Expr -> string list = function @@ -318,24 +326,18 @@ module internal rec StorybookCases = | Expr.TypeCast(expr = GetCases values) -> values | _ -> [] let field = caseExpr |> findAndDiscardElse (fieldExtractor >> _.IsSome) |> List.choose fieldExtractor - field |> sprintf "%A" |> PluginContext.logWarning ctx field |> List.map(fun fieldName -> { PropertyName = fieldName Cases = caseExpr |> function GetCases values -> values } ) - - let findMatchers (ctx: PluginContext) (expr: Expr list) = + let private findMatchers (ctx: PluginContext) (expr: Expr list) = let matcher = findAndDiscardElse (function | Let(ident = { Name = StartsWith("matchValue"); Type = Type.String }) -> true | _ -> false ) expr |> List.collect matcher |> List.map CasesExpr - // |> fun values -> - // values |> sprintf "%A" - // |> PluginContext.logWarning ctx - // values let getCases (ctx: PluginContext) (entityTyp: Type) (expr: Expr) = findMatchers ctx [expr] @@ -460,7 +462,6 @@ module internal rec StorybookVariantsAndArgs = ) findAndDiscardElse predicate expr |> List.collect processRawVariantExpr - |> AstUtils.Object open StorybookVariantsAndArgs @@ -473,7 +474,6 @@ module internal StorybookAST = else AstUtils.Import(name, entRef.SourcePath |> Option.defaultValue "", entRef) - let createUnionExprs(ctx: PluginContext) (entity: Entity) = let cases = if not entity.IsFSharpUnion then None @@ -487,6 +487,7 @@ module internal StorybookAST = ) let createStringEnumExprArray (ctx: PluginContext) (values: string list) = values |> List.map AstUtils.Value |> AstUtils.ValueArray + let private extractElementValue elementName: XDocument -> _ = _.XPathSelectElement($"//{elementName}") >> Option.ofObj @@ -496,33 +497,107 @@ module internal StorybookAST = | ArgType of string * Expr | Arg of string * Expr + /// Some argtypes will have the information available to them to create the + /// argument on the spot such as with fields that start with 'on' or have the + /// partas spy attribute + type FieldData = { + Name: string + Arg: Expr option + ArgType: Expr + XmlDocs: XDocument option + } + type StorybookAttributes = { + Spy: bool + ControlType: string option + HideControl: bool + } + type XmlDocInformation = { + DefaultValue: string option + Summary: string option + Storybook: StorybookAttributes + } + + let readXmlDocStringForField (prop: FieldType) = + prop.XmlDocs |> Option.map (fun docs -> + let normalizedDocs = "" + docs + "" + let read value = + use reader = new System.IO.StringReader(value) + XDocument.Load(reader) + let docs = read normalizedDocs + docs + ) let createMeta (ctx: PluginContext) (memberDecl: MemberDecl) (expr: Expr)= let typ = + // The computation expression gives us the generic arg in a predictable position match expr with | Call(typ = DeclaredType(_, GetDeclaredType typ :: _)) -> typ | _ -> failwith $"CreateMeta: Unexpected expr -> {expr}" let entity = + // We dig through the type to find the first declared entity in the generic arg match typ with | StorybookTypeRecursion.GetGenericArg ctx entity -> entity - let predefinedCases = StorybookCases.getCases ctx typ expr - let properties = StorybookTypeRecursion.collectEntityMembers ctx entity - let args = StorybookVariantsAndArgs.getArgs ctx expr - let variants = StorybookVariantsAndArgs.getVariants ctx expr + let entityXmlDocs = + // We extract the xml docs off the constructor if present, + // else we try to find if there are docs on a member with the + // solidtypecomponent attribute + entity.MembersFunctionsAndValues + |> Seq.tryFind _.IsConstructor + |> Option.bind (_.XmlDoc >> fun docs -> if docs |> Option.exists String.IsNullOrWhiteSpace then None else docs) + |> Option.orElse ( + entity.MembersFunctionsAndValues |> Seq.tryFind (_.Attributes >> Seq.exists (_.Entity.FullName >> (=) "Partas.Solid.SolidTypeComponent")) + |> Option.bind(_.XmlDoc >> Option.bind (fun docs -> if docs |> String.IsNullOrWhiteSpace then None else Some docs)) + ) + let predefinedCases = + // Cases from the `case` CE op + StorybookCases.getCases ctx typ expr + let properties = + // All property members of a type that are not + // derived from native partas solid tags + StorybookTypeRecursion.collectEntityMembers ctx entity + let args = + // Args defined in arg computation ops + getArgs ctx expr + let variants = + getVariants ctx expr + // We reverse the list so the variants are in the same order + // they were defined + |> List.rev + // The render custom op let render = StorybookRender.getRender ctx expr - let argTypes = + // Creating the field data + let fieldData = properties |> List.map (fun prop -> - let docs = prop.XmlDocs |> Option.map (fun docs -> - let normalizedDocs = "" + docs + "" - let read value = - use reader = new System.IO.StringReader(value) - XDocument.Load(reader) - let docs = read normalizedDocs - docs - ) + let docs = readXmlDocStringForField prop let getElementValue value = docs |> Option.bind (extractElementValue value) - let description = getElementValue "summary" - let defaultValue = getElementValue "defaultValue" + let docData = + let controlTypeAttribute = + docs |> Option.bind ( + _.XPathSelectElements("//storybook[@controlType]") + >> Seq.map (_.XPathEvaluate("string(@controlType)") >> unbox) + >> Seq.tryHead + ) + { + Summary = getElementValue "summary" + DefaultValue = getElementValue "defaultValue" + Storybook = { + Spy = + docs |> Option.map ( + _.XPathSelectElements("//storybook[@spy]") + >> Seq.map (_.XPathEvaluate("string(@spy)") >> unbox) + >> Seq.tryHead + >> Option.exists ((=) "true") + ) + |> Option.defaultValue false + ControlType = controlTypeAttribute + HideControl = + controlTypeAttribute |> Option.exists (_.ToLower() >> (=) "false") + || (controlTypeAttribute |> Option.exists (_.ToLower().StartsWith("hide"))) + } + } + let defaultValue = docData.DefaultValue + let description = docData.Summary + // options from the case names let options = predefinedCases |> List.tryFind (_.PropertyName >> (=) prop.Name) |> Option.map _.Cases let rec makeArgType typ = @@ -755,9 +830,32 @@ module internal StorybookAST = | _ -> AstUtils.Unit makeArgType prop.Type |> fun expr -> - prop.Name, expr + let name = prop.Name |> StringUtils.TrimReservedIdentifiers + { + Name = name + Arg = + let maybeArg = args |> List.tryFind (fst >> StringUtils.TrimReservedIdentifiers >> (=) name) |> Option.map snd + maybeArg + |> Option.orElse( + if (prop.Type.IsDelegateType || prop.Type.IsLambdaType) && (prop.Name.StartsWith "on" || docData.Storybook.Spy) then + Some <| AstUtils.Call(AstUtils.Import("fn", "storybook/test"), AstUtils.CallInfo()) + else None ) + ArgType = expr + XmlDocs = docs + } ) + // The closing macro string for valid jsx when considering what fable will push at + // the end let closeLastTemplate = "\nconst $PARTAS_DISCARD = { $discard: true" + (* The component property is a required property. Being the most predictable + property we're going to set, we place it at the end. + The Value field is then turned into a Emit macro instead of just an import expr. + This lets us 'inject' extra definitions, handle default exportation, et al. + Since we are not in control of the closing bracket and comma for the object, we + place a dummy discard at the end of the macro which will ensure the generation is + valid JSX. + If we don't create the macro string with the idents of the exports embedded, then we + end up generating string idents (if they are passed as values to the macro as usual).*) let compExpr = AstUtils.Emit( [ @@ -768,7 +866,7 @@ module internal StorybookAST = ] |> String.concat "\n", AstUtils.CallInfo(args = [ getComponentExprFromEntity ctx entity - AstUtils.Value memberDecl.Name + AstUtils.Value (memberDecl.Name |> StringUtils.TrimReservedIdentifiers) yield! ( variants |> List.map (fun (Variant (_,expr)) -> AstUtils.Object([ @@ -778,14 +876,32 @@ module internal StorybookAST = ) ]) ) + let argNames = args |> List.map (function name,expr -> name |> StringUtils.TrimReservedIdentifiers, expr) [ - "args", args - "argTypes", AstUtils.Object argTypes + "args", + fieldData + |> List.choose(fun data -> + argNames + |> List.tryFind (fst >> (=) data.Name) + |> function + | Some (_, expr) -> + Some(data.Name, expr) + | None when data.Arg.IsSome -> + Some(data.Name, data.Arg.Value) + | _ -> None + ) + |> AstUtils.Object + "argTypes", AstUtils.Object (fieldData |> List.map (function { Name = name; ArgType = expr } -> name,expr)) if render.IsSome then "render", render.Value "component", compExpr ] |> AstUtils.Object - // , () + |> fun expr -> + match memberDecl with + | { XmlDoc = None | Some "" } -> + { memberDecl with XmlDoc = entityXmlDocs } + | _ -> memberDecl + |> function memberDecl -> { memberDecl with Body = expr } [] let rec (|RootExpr|_|) ctx = function @@ -810,18 +926,11 @@ type PartasStorybookAttribute(compFlags: int) = let flags = enum compFlags override this.Transform(pluginHelper, file, memberDecl) = let ctx = PluginContext.create pluginHelper TransformationKind.MemberDecl flags - memberDecl |> printfn "%A" + if flags.HasFlag(ComponentFlag.DebugMode) then + memberDecl.Body + |> printfn "START MEMBER DECL!!!\n%A\nEND MEMBER DECL!!!" memberDecl |> StorybookAST.transform ctx - |> fun e -> - { memberDecl with Body = e } - // snd e |> sprintf "%A" |> PluginContext.logWarning ctx - // |> printfn "%A" - // |> printfn "%A" - // memberDecl - // |> fun newExpr -> - // newExpr |> printfn "%A" - // { memberDecl with Body = newExpr } override this.TransformCall(_, _, expr) = expr diff --git a/Partas.Solid/Partas.Solid.fsproj b/Partas.Solid/Partas.Solid.fsproj index e8a21d0..b3000a6 100644 --- a/Partas.Solid/Partas.Solid.fsproj +++ b/Partas.Solid/Partas.Solid.fsproj @@ -16,8 +16,8 @@ Shayan Habibi, Vladimir Schur and Contributors Copyright (c) Shayan Habibi 2025, based on work by Vladimir Schur 2024 README.md - 2.0.1 - 2.0.1 + 2.1.0-alpha.3 + 2.1.0-alpha.3 From ca8c60b7ba1e1126ff132a522f3dac187ac87f97 Mon Sep 17 00:00:00 2001 From: cabboose Date: Fri, 5 Sep 2025 23:29:14 +0800 Subject: [PATCH 04/13] known bug: render and arg variant pairs don't mesh well. Better to just stick to one or the other. Made it so key value pairs for children arg will have the value expr transformed by the main plugin --- .../Partas.Solid.FablePlugin.fsproj | 4 +- Partas.Solid.FablePlugin/Storybook.fs | 1484 +++++++++++------ Partas.Solid.FablePlugin/Utils.fs | 140 +- Partas.Solid/Partas.Solid.fsproj | 4 +- Partas.Solid/Storybook.fs | 97 +- 5 files changed, 1087 insertions(+), 642 deletions(-) diff --git a/Partas.Solid.FablePlugin/Partas.Solid.FablePlugin.fsproj b/Partas.Solid.FablePlugin/Partas.Solid.FablePlugin.fsproj index c554d96..a9565bd 100644 --- a/Partas.Solid.FablePlugin/Partas.Solid.FablePlugin.fsproj +++ b/Partas.Solid.FablePlugin/Partas.Solid.FablePlugin.fsproj @@ -13,8 +13,8 @@ MIT Shayan Habibi based on work by Vladimir Schur and contributors Copyright (c) Shayan Habibi 2025 - 2.1.0-alpha.3 - 2.1.0-alpha.3 + 2.1.0-alpha.4 + 2.1.0-alpha.4 diff --git a/Partas.Solid.FablePlugin/Storybook.fs b/Partas.Solid.FablePlugin/Storybook.fs index b9e4801..9cac540 100644 --- a/Partas.Solid.FablePlugin/Storybook.fs +++ b/Partas.Solid.FablePlugin/Storybook.fs @@ -17,6 +17,7 @@ do () type internal FieldType = | Field of Field | Member of MemberFunctionOrValue + member this.Type = match this with | Field field -> field.FieldType @@ -28,21 +29,28 @@ type internal FieldType = else memb.ReturnParameter |> _.Type + member this.XmlDocs = match this with | Field _ -> None | Member memb -> memb.XmlDoc |> Option.bind (fun docs -> - if docs |> String.IsNullOrWhiteSpace then + if + docs + |> String.IsNullOrWhiteSpace + then None - else Some docs - ) + else + Some docs) + member this.Attributes = match this with | Field _ -> [] | Member memb -> - memb.Attributes |> Seq.toList + memb.Attributes + |> Seq.toList + member this.Name = match this with | Field field -> field.Name @@ -63,6 +71,7 @@ type internal ControlType = | Color | Date | Text + override this.ToString() = match this with | Object -> "object" @@ -79,163 +88,244 @@ type internal ControlType = | Color -> "color" | Date -> "date" | Text -> "text" + /// Defaults to Object if fails to match static member Parse(value: string) = - match value.ToLower() with - | "boolean" | "bool" -> Boolean + match value.ToLower () with + | "boolean" + | "bool" -> Boolean | "check" -> Check - | "inline-check" | "inlinecheck" -> InlineCheck + | "inline-check" + | "inlinecheck" -> InlineCheck | "radio" -> Radio - | "inline-radio" | "inlineradio" -> InlineRadio + | "inline-radio" + | "inlineradio" -> InlineRadio | "select" -> Select - | "multi-select" | "multiselect" -> MultiSelect - | "number" | "int" | "float" -> Number + | "multi-select" + | "multiselect" -> MultiSelect + | "number" + | "int" + | "float" -> Number | "range" -> Range | "file" -> File - | "color" | "colour" -> Color - | "date" | "datetime" -> Date - | "text" | "string" -> Text + | "color" + | "colour" -> Color + | "date" + | "datetime" -> Date + | "text" + | "string" -> Text | _ -> Object [] module internal Utils = type AstUtils with static member TableInfo(?summary: string, ?detail: string) = - [ - if summary.IsSome then - "summary", summary.Value |> AstUtils.Value - if detail.IsSome then - "detail", detail.Value |> AstUtils.Value - ] |> AstUtils.Object - static member Table( - ?category: string, - ?defaultValueSummary: string, - ?defaultValueDetail: string, - ?disable: bool, - ?subcategory: string, - ?typSummary: string, - ?typDetail: string) = - [ - if category.IsSome then - "category", AstUtils.Value category.Value - if defaultValueDetail.IsSome || defaultValueSummary.IsSome then - "defaultValue", AstUtils.TableInfo(?summary = defaultValueSummary, ?detail = defaultValueDetail) - if disable.IsSome then - "disable", AstUtils.Value disable.Value - if typSummary.IsSome || typDetail.IsSome then - "type", AstUtils.TableInfo(?summary = typSummary, ?detail = typDetail) - if subcategory.IsSome then - "subcategory", AstUtils.Value subcategory.Value - ] |> AstUtils.Object - static member ControlType( - ?typ: ControlType, - ?accept: string, - // todo ? - ?labels: (string * string) list, - ?max: Expr, - ?min: Expr, - ?presetColors: string list, - ?step: Expr, - ?doNotRender: bool - ) = - let doNotRender = defaultArg doNotRender false - [ - if typ.IsSome && not doNotRender then - "type", AstUtils.Value(typ.Value.ToString()) - elif doNotRender then - "type", AstUtils.Value(false) - if accept.IsSome then - "accept", AstUtils.Value(accept.Value) - if labels.IsSome then - "labels", - labels.Value - |> List.map (snd >> AstUtils.Value) - |> List.zip (labels.Value |> List.map fst) - |> AstUtils.Object - if max.IsSome then - "max", max.Value - if min.IsSome then - "min", min.Value - if presetColors.IsSome then - "presetColors", - presetColors.Value - |> List.map AstUtils.Value - |> AstUtils.ValueArray - if step.IsSome then - "step", step.Value - - ] |> AstUtils.Object - static member ArgType( - ?control: Expr, - ?description: string, - ?conditional: Expr, - ?mapping: Expr, - ?name: string, - ?options: Expr list, - ?table: Expr, - ?typ: Expr) = - [ - if control.IsSome then "control", control.Value - if description.IsSome then "description", AstUtils.Value(description.Value) - if conditional.IsSome then "conditional", conditional.Value - if mapping.IsSome then "mapping", mapping.Value - if name.IsSome then "name", AstUtils.Value name.Value - if options.IsSome then "options", AstUtils.ValueArray options.Value - if table.IsSome then "table", table.Value - if typ.IsSome then "type", typ.Value - ] |> AstUtils.Object - static member Meta( - comp: Expr, - ?subComps: Expr list, - ?args: Expr, - ?argTypes: Expr, - ?render: Expr, - ?stories: string list, - ?parameters: Expr, - ?tags: string list + [ if summary.IsSome then + "summary", + summary.Value + |> AstUtils.Value + if detail.IsSome then + "detail", + detail.Value + |> AstUtils.Value ] + |> AstUtils.Object + + static member Table + ( + ?category: string, + ?defaultValueSummary: string, + ?defaultValueDetail: string, + ?disable: bool, + ?subcategory: string, + ?typSummary: string, + ?typDetail: string + ) = + [ if category.IsSome then + "category", AstUtils.Value category.Value + if + defaultValueDetail.IsSome + || defaultValueSummary.IsSome + then + "defaultValue", AstUtils.TableInfo (?summary = defaultValueSummary, ?detail = defaultValueDetail) + if disable.IsSome then + "disable", AstUtils.Value disable.Value + if + typSummary.IsSome + || typDetail.IsSome + then + "type", AstUtils.TableInfo (?summary = typSummary, ?detail = typDetail) + if subcategory.IsSome then + "subcategory", AstUtils.Value subcategory.Value ] + |> AstUtils.Object + + static member ControlType + (?typ: string, ?accept: string, ?labels: (string * string) list, ?max: Expr, ?min: Expr, ?presetColors: string list, ?step: Expr) + = + let doNotRender = + typ + |> Option.exists ((=) "false") + + [ if + typ.IsSome + && not doNotRender + then + "type", AstUtils.Value (typ.Value.ToString ()) + elif doNotRender then + "type", AstUtils.Value (false) + if accept.IsSome then + "accept", AstUtils.Value (accept.Value) + if labels.IsSome then + "labels", + labels.Value + |> List.map ( + snd + >> AstUtils.Value + ) + |> List.zip ( + labels.Value + |> List.map fst + ) + |> AstUtils.Object + if max.IsSome then + "max", max.Value + if min.IsSome then + "min", min.Value + if presetColors.IsSome then + "presetColors", + presetColors.Value + |> List.map AstUtils.Value + |> AstUtils.ValueArray + if step.IsSome then + "step", step.Value + + ] + |> AstUtils.Object + + static member ControlType + ( + ?typ: ControlType, + ?accept: string, + // todo ? + ?labels: (string * string) list, + ?max: Expr, + ?min: Expr, + ?presetColors: string list, + ?step: Expr, + ?doNotRender: bool + ) = + AstUtils.ControlType ( + ?typ = + (typ + |> Option.map _.ToString() + |> Option.orElse ( + if + doNotRender.IsSome + && doNotRender.Value + then + Some "false" + else + None + )), + ?accept = accept, + ?labels = labels, + ?max = max, + ?min = min, + ?presetColors = presetColors, + ?step = step + ) + + static member ArgType + (?control: Expr, ?description: string, ?conditional: Expr, ?mapping: Expr, ?name: string, ?options: Expr list, ?table: Expr, ?typ: Expr) + = + [ if control.IsSome then + "control", control.Value + if description.IsSome then + "description", AstUtils.Value (description.Value) + if conditional.IsSome then + "conditional", conditional.Value + if mapping.IsSome then + "mapping", mapping.Value + if name.IsSome then + "name", AstUtils.Value name.Value + if options.IsSome then + "options", AstUtils.ValueArray options.Value + if table.IsSome then + "table", table.Value + if typ.IsSome then + "type", typ.Value ] + |> AstUtils.Object + + static member Meta + ( + comp: Expr, + ?subComps: Expr list, + ?args: Expr, + ?argTypes: Expr, + ?render: Expr, + ?stories: string list, + ?parameters: Expr, + ?tags: string list ) = - [ - "component", comp - if subComps.IsSome then "subcomponents", AstUtils.ValueArray subComps.Value - if args.IsSome then "args", args.Value - if argTypes.IsSome then "argTypes", argTypes.Value - if render.IsSome then "render", render.Value - if stories.IsSome then "stories", stories.Value |> List.map AstUtils.Value |> AstUtils.ValueArray - if parameters.IsSome then "parameters", parameters.Value - if tags.IsSome then "tags", tags.Value |> List.map AstUtils.Value |> AstUtils.ValueArray - ] |> AstUtils.Object + [ "component", comp + if subComps.IsSome then + "subcomponents", AstUtils.ValueArray subComps.Value + if args.IsSome then + "args", args.Value + if argTypes.IsSome then + "argTypes", argTypes.Value + if render.IsSome then + "render", render.Value + if stories.IsSome then + "stories", + stories.Value + |> List.map AstUtils.Value + |> AstUtils.ValueArray + if parameters.IsSome then + "parameters", parameters.Value + if tags.IsSome then + "tags", + tags.Value + |> List.map AstUtils.Value + |> AstUtils.ValueArray ] + |> AstUtils.Object + module internal rec StorybookTypeRecursion = let (|EntityFullName|): DeclaredType -> string = _.Entity.FullName + /// Filter interfaces that are predefined as thats too much noise. - let (|FeedInterface|) (ctx: PluginContext): DeclaredType list -> DeclaredType list = function + let (|FeedInterface|) (ctx: PluginContext) : DeclaredType list -> DeclaredType list = + function | [] -> [] | declaredType :: FeedInterface ctx rest -> match declaredType with - | EntityFullName (StartsWith "Partas.Solid.Tags") -> - rest + | EntityFullName (StartsWith "Partas.Solid.Tags") -> rest | ent -> - ent :: rest + ent + :: rest + let private filterMembers (ctx: PluginContext) (decls: MemberFunctionOrValue seq) = decls |> Seq.filter (fun memb -> - ( - memb.IsInline - || memb.IsInternal - || memb.IsPrivate - || memb.CurriedParameterGroups |> List.collect id |> List.length > 1 - ) |> not - && memb.IsSetter - ) + (memb.IsInline + || memb.IsInternal + || memb.IsPrivate + || memb.CurriedParameterGroups + |> List.collect id + |> List.length > 1) + |> not + && memb.IsSetter) let private getFilteredMembers (ctx: PluginContext) (decl: DeclaredType) = let entity = ctx.Helper.GetEntity decl.Entity + entity.MembersFunctionsAndValues |> filterMembers ctx let private getEntityInterfaces (ctx: PluginContext) (ent: Entity) = ent.AllInterfaces |> Seq.toList - |> function FeedInterface ctx interfaces -> interfaces + |> function + | FeedInterface ctx interfaces -> interfaces let private getEntity (ctx: PluginContext) (entityRef: DeclaredType) = ctx.Helper.GetEntity entityRef.Entity @@ -246,113 +336,202 @@ module internal rec StorybookTypeRecursion = |> filterMembers ctx |> Seq.map FieldType.Member |> Seq.toList + entity.BaseType - |> Option.map (getEntity ctx >> getEntityMembers ctx) + |> Option.map ( + getEntity ctx + >> getEntityMembers ctx + ) |> Option.defaultValue [] |> List.append getMembers + let rec private collectEntityFields (ctx: PluginContext) (ent: Entity) = ent.BaseType - |> Option.map (getEntity ctx >> collectEntityFields ctx) + |> Option.map ( + getEntity ctx + >> collectEntityFields ctx + ) |> Option.defaultValue [] |> List.append ent.FSharpFields - |> List.filter (_.Name.EndsWith('@') >> not) + |> List.filter ( + _.Name.EndsWith('@') + >> not + ) - let (|GetGenericArg|) (ctx: PluginContext) = function - | GetDeclaredType (Type.DeclaredType(ref, _)) -> - ctx.Helper.GetEntity ref + let (|GetGenericArg|) (ctx: PluginContext) = + function + | GetDeclaredType (Type.DeclaredType (ref, _)) -> ctx.Helper.GetEntity ref | _ -> failwith "Incorrect AST structure. Different to expected." let rec collectEntityMembers (ctx: PluginContext) (entity: Entity) = - let baseAndEntityFields = collectEntityFields ctx entity |> List.map FieldType.Field + let baseAndEntityFields = + collectEntityFields ctx entity + |> List.map FieldType.Field + let interfaceMembers = getEntityInterfaces ctx entity |> Seq.collect (getFilteredMembers ctx) |> Seq.map FieldType.Member |> Seq.toList - let entityMembers = - getEntityMembers ctx entity - baseAndEntityFields @ interfaceMembers @ entityMembers + + let entityMembers = getEntityMembers ctx entity + + baseAndEntityFields + @ interfaceMembers + @ entityMembers module internal rec StorybookCases = type CasesExpr = CasesExpr of Expr - type Cases = { - PropertyName: string - Cases: string list - } + + type Cases = + { PropertyName: string + Cases: string list } + let private makeCases (ctx: PluginContext) (typ: Type) (CasesExpr caseExpr) = - let fieldExtractor: Expr -> string option = function - | Get(expr = IdentExpr { Type = identTyp }; kind = ( - GetKind.ExprGet(Value(kind = ValueKind.StringConstant(field))) - | GetKind.FieldGet( { Name = field } ) - )) when identTyp = typ -> + let fieldExtractor: Expr -> string option = + function + | Get ( + expr = IdentExpr { Type = identTyp } + kind = (GetKind.ExprGet (Value (kind = ValueKind.StringConstant (field))) | GetKind.FieldGet ({ Name = field }))) when identTyp = typ -> Some field - | Call(callee=Import(typ = LambdaType(argType = typInfo); info = { Kind = MemberImport(MemberRef(_, { CompiledName = compiledName })) })) when typ = typInfo -> - compiledName.Split('.') |> Array.last - |> function StartsWithTrimmed "get_" value -> value |> StringUtils.TrimReservedIdentifiers |> Some - | _ -> None + | Call ( + callee = Import (typ = LambdaType (argType = typInfo); info = { Kind = MemberImport (MemberRef (_, { CompiledName = compiledName })) })) when + typ = typInfo + -> + compiledName.Split ('.') + |> Array.last + |> function + | StartsWithTrimmed "get_" value -> + value + |> StringUtils.TrimReservedIdentifiers + |> Some + | _ -> None | _ -> None + let rec (|GetCases|): Expr -> string list = function - | Expr.Call(callee = GetCases values; info = { Args = GetCases headValues :: exprs }) -> - values @ headValues @ (exprs |> List.collect (function GetCases values -> values)) - | Expr.CurriedApply(applied = GetCases values; args = exprs) -> - values @ (exprs |> List.collect (function GetCases values -> values)) - | Expr.DecisionTree(expr = GetCases values; targets = targets) -> - values @ (targets |> List.collect (snd >> function GetCases values -> values)) - | Expr.Delegate(body = GetCases values) -> values - | Expr.DecisionTreeSuccess(boundValues = exprs) -> - List.collect (function GetCases values -> values) exprs - | Expr.Get(expr = GetCases values; kind = kind) -> + | Expr.Call (callee = GetCases values; info = { Args = GetCases headValues :: exprs }) -> + values + @ headValues + @ (exprs + |> List.collect (function + | GetCases values -> values)) + | Expr.CurriedApply (applied = GetCases values; args = exprs) -> + values + @ (exprs + |> List.collect (function + | GetCases values -> values)) + | Expr.DecisionTree (expr = GetCases values; targets = targets) -> + values + @ (targets + |> List.collect ( + snd + >> function + | GetCases values -> values + )) + | Expr.Delegate (body = GetCases values) -> values + | Expr.DecisionTreeSuccess (boundValues = exprs) -> + List.collect + (function + | GetCases values -> values) + exprs + | Expr.Get (expr = GetCases values; kind = kind) -> match kind with | ExprGet (GetCases values) -> values | _ -> [] @ values - | Expr.IfThenElse(guardExpr = GetCases values; elseExpr = GetCases elseValues; thenExpr = GetCases thenValues) -> - values @ elseValues @ thenValues - | Expr.Lambda(body = GetCases values) -> values - | Expr.Let(value = GetCases values; body = GetCases bodyValues) -> values @ bodyValues - | Expr.LetRec(bindings = exprs; body = GetCases values) -> - (exprs |> List.collect (snd >> function GetCases values -> values)) @ values - | Expr.ObjectExpr(baseCall = Some(GetCases values); members = members) -> - values @ (members |> List.collect (_.Body >> function GetCases memberValues -> memberValues) ) - | Expr.ObjectExpr(members = members) -> - members |> List.collect (_.Body >> function GetCases values -> values) - | Expr.Operation(kind = OperationKind.Binary(operator = BinaryOperator.BinaryEqual; right = Value(kind = StringConstant value); left = GetCases values)) -> - value :: values - | Expr.Operation(kind = OperationKind.Binary(operator = BinaryOperator.BinaryEqual; right = GetCases values; left = GetCases leftValues)) -> - leftValues @ values - | Expr.Sequential(exprs = exprs) -> - exprs |> List.collect (function GetCases values -> values) - | Expr.TypeCast(expr = GetCases values) -> values + | Expr.IfThenElse (guardExpr = GetCases values; elseExpr = GetCases elseValues; thenExpr = GetCases thenValues) -> + values + @ elseValues + @ thenValues + | Expr.Lambda (body = GetCases values) -> values + | Expr.Let (value = GetCases values; body = GetCases bodyValues) -> + values + @ bodyValues + | Expr.LetRec (bindings = exprs; body = GetCases values) -> + (exprs + |> List.collect ( + snd + >> function + | GetCases values -> values + )) + @ values + | Expr.ObjectExpr (baseCall = Some (GetCases values); members = members) -> + values + @ (members + |> List.collect ( + _.Body + >> function + | GetCases memberValues -> memberValues + )) + | Expr.ObjectExpr (members = members) -> + members + |> List.collect ( + _.Body + >> function + | GetCases values -> values + ) + | Expr.Operation ( + kind = OperationKind.Binary ( + operator = BinaryOperator.BinaryEqual; right = Value (kind = StringConstant value); left = GetCases values)) -> + value + :: values + | Expr.Operation (kind = OperationKind.Binary (operator = BinaryOperator.BinaryEqual; right = GetCases values; left = GetCases leftValues)) -> + leftValues + @ values + | Expr.Sequential (exprs = exprs) -> + exprs + |> List.collect (function + | GetCases values -> values) + | Expr.TypeCast (expr = GetCases values) -> values | _ -> [] - let field = caseExpr |> findAndDiscardElse (fieldExtractor >> _.IsSome) |> List.choose fieldExtractor - field |> List.map(fun fieldName -> { - PropertyName = fieldName - Cases = caseExpr - |> function GetCases values -> values } ) + + let field = + caseExpr + |> findAndDiscardElse ( + fieldExtractor + >> _.IsSome + ) + |> List.choose fieldExtractor + + field + |> List.map (fun fieldName -> + { PropertyName = fieldName + Cases = + caseExpr + |> function + | GetCases values -> values }) let private findMatchers (ctx: PluginContext) (expr: Expr list) = let matcher = findAndDiscardElse (function - | Let(ident = { Name = StartsWith("matchValue"); Type = Type.String }) -> true - | _ -> false - ) - expr |> List.collect matcher |> List.map CasesExpr + | Let ( + ident = { Name = StartsWith ("matchValue") + Type = Type.String }) -> true + | _ -> false) + + expr + |> List.collect matcher + |> List.map CasesExpr let getCases (ctx: PluginContext) (entityTyp: Type) (expr: Expr) = - findMatchers ctx [expr] + findMatchers ctx [ expr ] |> List.collect (makeCases ctx entityTyp) |> List.groupBy _.PropertyName - |> List.map (fun (key,cases) -> { - PropertyName = key - Cases = cases |> List.collect _.Cases |> List.distinct - } ) + |> List.map (fun (key, cases) -> + { PropertyName = key + Cases = + cases + |> List.collect _.Cases + |> List.distinct }) module internal rec StorybookRender = let getRender (ctx: PluginContext) (expr: Expr) = - let predicate = function - | Lambda(name = Some (StartsWith "PARTAS_RENDER")) -> true + let predicate = + function + | Lambda (name = Some (StartsWith "PARTAS_RENDER")) -> true | _ -> false + findAndDiscardElse predicate expr |> List.tryHead |> Option.map (AST.transform ctx) @@ -360,106 +539,162 @@ module internal rec StorybookRender = module internal rec StorybookVariantsAndArgs = type RawVariantExpr = RawVariantExpr of variantName: string * expr: Expr type Variant = Variant of variantName: string * args: (string * Expr) list + type VariantRender = VariantRender of variantName: string * render: Expr + + let getVariantRenders (ctx: PluginContext) (expr: Expr) = + let predicate = + function + | Expr.Sequential (TypeCast (expr = Value (kind = StringConstant (StartsWith "PARTAS_RENDER_VARIANT"))) :: _) -> true + | _ -> false + + let recursiveDiscovery expr = + findAndDiscardElse predicate expr + |> List.map (fun expr -> + match expr with + | Expr.Sequential (TypeCast (expr = Value (kind = StringConstant (StartsWithTrimmed "PARTAS_RENDER_VARIANT" name))) :: exprs) -> + name, + let predicate = + function + | Lambda (name = Some "PARTAS_VARIANT_RENDER") -> true + | _ -> false + + List.collect (findAndDiscardElse predicate) exprs + |> List.head + |> AST.transform ctx + | _ -> failwith "Unreachable") + |> List.map VariantRender + + recursiveDiscovery expr + let getVariants (ctx: PluginContext) (expr: Expr) = - let predicate = function - | Expr.Sequential (TypeCast(expr = Value(kind = StringConstant (StartsWith "PARTAS_VARIANT"))) :: _ ) -> true + let predicate = + function + | Expr.Sequential (TypeCast (expr = Value (kind = StringConstant (StartsWith "PARTAS_VARIANT"))) :: _) -> true | _ -> false + let rec recursiveDiscovery expr = findAndDiscardElse predicate expr |> List.collect (function - | Expr.Sequential( _ :: exprs ) as expr -> - expr :: - (exprs - |> List.collect recursiveDiscovery) - | e -> [ e ] - ) - let extractVariantExprs = function - | Sequential (nameExpr :: (Sequential (TypeCast(expr = expr) :: _) :: _)) -> + | Expr.Sequential (_ :: exprs) as expr -> + expr + :: (exprs + |> List.collect recursiveDiscovery) + | e -> [ e ]) + + let extractVariantExprs = + function + | Sequential (nameExpr :: (Sequential (TypeCast (expr = expr) :: _) :: _)) -> let variantName = match nameExpr with - | TypeCast(expr = Value(kind = StringConstant (StartsWithTrimmed "PARTAS_VARIANT" variantName))) -> Some variantName + | TypeCast (expr = Value (kind = StringConstant (StartsWithTrimmed "PARTAS_VARIANT" variantName))) -> Some variantName | _ -> None - variantName |> Option.map (fun variantName -> RawVariantExpr(variantName, expr)) + + variantName + |> Option.map (fun variantName -> RawVariantExpr (variantName, expr)) | _ -> None - let processRawVariantExpr (RawVariantExpr(name,expr)) = - let predicate = function + + let processRawVariantExpr (RawVariantExpr (name, expr)) = + let predicate = + function | Set _ -> true - | Call(callee = Import(info = { Kind = ImportKind.MemberImport (MemberRef(info = { CompiledName = compiledName })) })) - when - compiledName - |> _.Split('.') - |> Array.last - |> _.StartsWith("set_") -> + | Call (callee = Import (info = { Kind = ImportKind.MemberImport (MemberRef (info = { CompiledName = compiledName })) })) when + compiledName + |> _.Split('.') + |> Array.last + |> _.StartsWith("set_") + -> true | _ -> false + findAndDiscardElse predicate expr |> List.choose (function - | Set(kind = SetKind.FieldSet propName; value = value) -> - Some(propName, value) - | Call( - callee = Import(info = { Kind = ImportKind.MemberImport (MemberRef(info = { CompiledName = compiledName }))}) - info = { Args = exprs } - ) - when - compiledName.Split('.') - |> Array.last - |> _.StartsWith("set_") -> + | Set (kind = SetKind.FieldSet propName; value = value) -> Some (propName, value) + | Call ( + callee = Import (info = { Kind = ImportKind.MemberImport (MemberRef (info = { CompiledName = compiledName })) }) + info = { Args = exprs }) when + compiledName.Split ('.') + |> Array.last + |> _.StartsWith("set_") + -> let prop = - compiledName.Split('.') + compiledName.Split ('.') |> Array.last - |> function StartsWithTrimmed "set_" value -> value | _ -> failwith "Unreachable" - Some (prop, - if exprs.Length > 1 then - Sequential exprs - elif exprs.Length = 0 then - AstUtils.Unit - else exprs |> List.head) - | _ -> None - ) + |> function + | StartsWithTrimmed "set_" value -> value + | _ -> failwith "Unreachable" + + Some ( + prop, + if exprs.Length > 1 then + Sequential exprs + elif exprs.Length = 0 then + AstUtils.Unit + else + exprs + |> List.head + ) + | _ -> None) |> fun args -> - Variant(name, args) + let args = + args + |> List.map (function + | "children", expr -> "children", AST.transform ctx expr + | prop, expr -> prop, expr) + + Variant (name, args) + recursiveDiscovery expr |> List.choose extractVariantExprs |> List.map processRawVariantExpr + let getArgs (ctx: PluginContext) (expr: Expr) = - let predicate = function - | Lambda(name = Some(StartsWith "PARTAS_ARGS")) -> true + let predicate = + function + | Lambda (name = Some (StartsWith "PARTAS_ARGS")) -> true | _ -> false + let processRawVariantExpr expr = - let predicate = function + let predicate = + function | Set _ -> true - | Call(callee = Import(info = { Kind = ImportKind.MemberImport (MemberRef(info = { CompiledName = compiledName })) })) - when - compiledName - |> _.Split('.') - |> Array.last - |> _.StartsWith("set_") -> + | Call (callee = Import (info = { Kind = ImportKind.MemberImport (MemberRef (info = { CompiledName = compiledName })) })) when + compiledName + |> _.Split('.') + |> Array.last + |> _.StartsWith("set_") + -> true | _ -> false + findAndDiscardElse predicate expr |> List.choose (function - | Set(kind = SetKind.FieldSet propName; value = value) -> - Some(propName, value) - | Call( - callee = Import(info = { Kind = ImportKind.MemberImport (MemberRef(info = { CompiledName = compiledName }))}) - info = { Args = exprs } - ) - when - compiledName.Split('.') - |> Array.last - |> _.StartsWith("set_") -> + | Set (kind = SetKind.FieldSet propName; value = value) -> Some (propName, value) + | Call ( + callee = Import (info = { Kind = ImportKind.MemberImport (MemberRef (info = { CompiledName = compiledName })) }) + info = { Args = exprs }) when + compiledName.Split ('.') + |> Array.last + |> _.StartsWith("set_") + -> let prop = - compiledName.Split('.') + compiledName.Split ('.') |> Array.last - |> function StartsWithTrimmed "set_" value -> value | _ -> failwith "Unreachable" - Some (prop, - if exprs.Length > 1 then - Sequential exprs - elif exprs.Length = 0 then - AstUtils.Unit - else exprs |> List.head) - | _ -> None - ) + |> function + | StartsWithTrimmed "set_" value -> value + | _ -> failwith "Unreachable" + + Some ( + prop, + if exprs.Length > 1 then + Sequential exprs + elif exprs.Length = 0 then + AstUtils.Unit + else + exprs + |> List.head + ) + | _ -> None) + findAndDiscardElse predicate expr |> List.collect processRawVariantExpr @@ -469,26 +704,36 @@ module internal StorybookAST = let getComponentExprFromEntity (ctx: PluginContext) (entity: Entity) = let name = entity.DisplayName let entRef = entity.Ref - if entRef.SourcePath |> Option.exists ((=) ctx.Helper.CurrentFile) then - AstUtils.IdentExpr(name) + + if + entRef.SourcePath + |> Option.exists ((=) ctx.Helper.CurrentFile) + then + AstUtils.IdentExpr (name) else - AstUtils.Import(name, entRef.SourcePath |> Option.defaultValue "", entRef) + AstUtils.Import ( + name, + entRef.SourcePath + |> Option.defaultValue "", + entRef + ) - let createUnionExprs(ctx: PluginContext) (entity: Entity) = + let createUnionExprs (ctx: PluginContext) (entity: Entity) = let cases = - if not entity.IsFSharpUnion then None + if not entity.IsFSharpUnion then + None else - Some entity.UnionCases + Some entity.UnionCases + cases - |> Option.map( - List.mapi (fun idx case -> - Expr.Value(ValueKind.NewUnion([], idx, entity.Ref, []), None) - ) - ) + |> Option.map (List.mapi (fun idx case -> Expr.Value (ValueKind.NewUnion ([], idx, entity.Ref, []), None))) + let createStringEnumExprArray (ctx: PluginContext) (values: string list) = - values |> List.map AstUtils.Value |> AstUtils.ValueArray + values + |> List.map AstUtils.Value + |> AstUtils.ValueArray - let private extractElementValue elementName: XDocument -> _ = + let private extractElementValue elementName : XDocument -> _ = _.XPathSelectElement($"//{elementName}") >> Option.ofObj >> Option.map (_.Value.Trim()) @@ -500,350 +745,477 @@ module internal StorybookAST = /// Some argtypes will have the information available to them to create the /// argument on the spot such as with fields that start with 'on' or have the /// partas spy attribute - type FieldData = { - Name: string - Arg: Expr option - ArgType: Expr - XmlDocs: XDocument option - } - type StorybookAttributes = { - Spy: bool - ControlType: string option - HideControl: bool - } - type XmlDocInformation = { - DefaultValue: string option - Summary: string option - Storybook: StorybookAttributes - } + type FieldData = + { Name: string + Arg: Expr option + ArgType: Expr + XmlDocs: XDocument option } + + type StorybookAttributes = + { Spy: bool + ControlType: string option + HideControl: bool } + + type XmlDocInformation = + { DefaultValue: string option + Summary: string option + Storybook: StorybookAttributes } let readXmlDocStringForField (prop: FieldType) = - prop.XmlDocs |> Option.map (fun docs -> - let normalizedDocs = "" + docs + "" - let read value = - use reader = new System.IO.StringReader(value) - XDocument.Load(reader) - let docs = read normalizedDocs - docs - ) - let createMeta (ctx: PluginContext) (memberDecl: MemberDecl) (expr: Expr)= + prop.XmlDocs + |> Option.map (fun docs -> + let normalizedDocs = + "" + + docs + + "" + + let read value = + use reader = new System.IO.StringReader (value) + XDocument.Load (reader) + + let docs = read normalizedDocs + docs) + + let createMeta (ctx: PluginContext) (memberDecl: MemberDecl) (expr: Expr) = let typ = // The computation expression gives us the generic arg in a predictable position match expr with - | Call(typ = DeclaredType(_, GetDeclaredType typ :: _)) -> typ + | Call (typ = DeclaredType (_, GetDeclaredType typ :: _)) -> typ | _ -> failwith $"CreateMeta: Unexpected expr -> {expr}" + let entity = // We dig through the type to find the first declared entity in the generic arg match typ with - | StorybookTypeRecursion.GetGenericArg ctx entity -> - entity + | StorybookTypeRecursion.GetGenericArg ctx entity -> entity + let entityXmlDocs = // We extract the xml docs off the constructor if present, // else we try to find if there are docs on a member with the // solidtypecomponent attribute entity.MembersFunctionsAndValues |> Seq.tryFind _.IsConstructor - |> Option.bind (_.XmlDoc >> fun docs -> if docs |> Option.exists String.IsNullOrWhiteSpace then None else docs) + |> Option.bind ( + _.XmlDoc + >> fun docs -> + if + docs + |> Option.exists String.IsNullOrWhiteSpace + then + None + else + docs + ) |> Option.orElse ( - entity.MembersFunctionsAndValues |> Seq.tryFind (_.Attributes >> Seq.exists (_.Entity.FullName >> (=) "Partas.Solid.SolidTypeComponent")) - |> Option.bind(_.XmlDoc >> Option.bind (fun docs -> if docs |> String.IsNullOrWhiteSpace then None else Some docs)) + entity.MembersFunctionsAndValues + |> Seq.tryFind ( + _.Attributes + >> Seq.exists ( + _.Entity.FullName + >> (=) "Partas.Solid.SolidTypeComponent" + ) ) + |> Option.bind ( + _.XmlDoc + >> Option.bind (fun docs -> + if + docs + |> String.IsNullOrWhiteSpace + then + None + else + Some docs) + ) + ) + let predefinedCases = // Cases from the `case` CE op StorybookCases.getCases ctx typ expr + let properties = // All property members of a type that are not // derived from native partas solid tags StorybookTypeRecursion.collectEntityMembers ctx entity + let args = // Args defined in arg computation ops getArgs ctx expr + let variants = getVariants ctx expr // We reverse the list so the variants are in the same order // they were defined |> List.rev + + let variantRenders = + getVariantRenders ctx expr + |> List.rev + + let variantCombinations = + variants + |> List.map (function + | Variant (name, args) -> + variantRenders + |> List.tryFind ( + (function + | VariantRender (renderName, _) -> renderName) + >> (=) name + ) + |> function + | Some (VariantRender (_, render)) -> name, AstUtils.Object [ "args", AstUtils.Object args; "render", render ] + | None -> name, AstUtils.Object [ "args", AstUtils.Object args ]) + |> List.append ( + variantRenders + |> List.choose (function + | VariantRender (name, render) -> + if + variants + |> List.exists ( + (function + | Variant (vname, _) -> vname) + >> (=) name + ) + then + None + else + (name, AstUtils.Object [ "render", render ]) + |> Some) + ) // The render custom op let render = StorybookRender.getRender ctx expr // Creating the field data let fieldData = - properties |> List.map (fun prop -> + properties + |> List.map (fun prop -> let docs = readXmlDocStringForField prop - let getElementValue value = docs |> Option.bind (extractElementValue value) + + let getElementValue value = + docs + |> Option.bind (extractElementValue value) + let docData = let controlTypeAttribute = - docs |> Option.bind ( + docs + |> Option.bind ( _.XPathSelectElements("//storybook[@controlType]") - >> Seq.map (_.XPathEvaluate("string(@controlType)") >> unbox) + >> Seq.map ( + _.XPathEvaluate("string(@controlType)") + >> unbox + ) >> Seq.tryHead + ) + + { Summary = getElementValue "summary" + DefaultValue = getElementValue "defaultValue" + Storybook = + { Spy = + docs + |> Option.map ( + _.XPathSelectElements("//storybook[@spy]") + >> Seq.map ( + _.XPathEvaluate("string(@spy)") + >> unbox + ) + >> Seq.tryHead + >> Option.exists ((=) "true") + ) + |> Option.defaultValue false + ControlType = controlTypeAttribute + HideControl = + controlTypeAttribute + |> Option.exists ( + _.ToLower() + >> (=) "false" ) - { - Summary = getElementValue "summary" - DefaultValue = getElementValue "defaultValue" - Storybook = { - Spy = - docs |> Option.map ( - _.XPathSelectElements("//storybook[@spy]") - >> Seq.map (_.XPathEvaluate("string(@spy)") >> unbox) - >> Seq.tryHead - >> Option.exists ((=) "true") - ) - |> Option.defaultValue false - ControlType = controlTypeAttribute - HideControl = - controlTypeAttribute |> Option.exists (_.ToLower() >> (=) "false") - || (controlTypeAttribute |> Option.exists (_.ToLower().StartsWith("hide"))) - } - } + || (controlTypeAttribute + |> Option.exists (_.ToLower().StartsWith ("hide"))) } } + let defaultValue = docData.DefaultValue let description = docData.Summary // options from the case names let options = - predefinedCases |> List.tryFind (_.PropertyName >> (=) prop.Name) |> Option.map _.Cases + predefinedCases + |> List.tryFind ( + _.PropertyName + >> (=) prop.Name + ) + |> Option.map _.Cases + + let controlTypeDefault (value: ControlType) = + docData.Storybook.ControlType + |> Option.defaultValue (value.ToString ()) + let rec makeArgType typ = match typ with | Any -> - let control = AstUtils.ControlType(typ = ControlType.Object) - AstUtils.ArgType( + let control = AstUtils.ControlType (typ = controlTypeDefault ControlType.Object) + + AstUtils.ArgType ( control = control, - table = AstUtils.Table(?defaultValueSummary = defaultValue), + table = AstUtils.Table (typSummary = "any", ?defaultValueSummary = defaultValue), ?description = description - ) + ) | Type.Boolean -> - let control = AstUtils.ControlType(typ = ControlType.Boolean) - AstUtils.ArgType( + let control = AstUtils.ControlType (typ = controlTypeDefault ControlType.Boolean) + + AstUtils.ArgType ( control = control, - table = AstUtils.Table(?defaultValueSummary = defaultValue), + table = AstUtils.Table (typSummary = "bool", ?defaultValueSummary = defaultValue), ?description = description - ) + ) | Char -> - let control = AstUtils.ControlType(typ = ControlType.Text) - AstUtils.ArgType( + let control = AstUtils.ControlType (typ = controlTypeDefault ControlType.Text) + + AstUtils.ArgType ( control = control, - table = AstUtils.Table(typSummary = "Char", typDetail = "Single length text", ?defaultValueSummary = defaultValue), + table = AstUtils.Table (typSummary = "char", typDetail = "Single length text", ?defaultValueSummary = defaultValue), ?description = description - ) + ) | String -> match options with | Some values -> - let control = AstUtils.ControlType( - typ = - if values.Length < 6 then ControlType.Radio - else ControlType.Select + let control = + AstUtils.ControlType ( + typ = + (if values.Length < 6 then + ControlType.Radio + else + ControlType.Select + |> controlTypeDefault) ) - AstUtils.ArgType( + + AstUtils.ArgType ( control = control, - table = AstUtils.Table(?defaultValueSummary = defaultValue), - options = (values |> List.map AstUtils.Value), + table = AstUtils.Table (typSummary = "[]", ?defaultValueSummary = defaultValue), + options = + (values + |> List.map AstUtils.Value), ?description = description - ) + ) | None -> - let control = AstUtils.ControlType(typ = ControlType.Text) - AstUtils.ArgType( + let control = AstUtils.ControlType (typ = controlTypeDefault ControlType.Text) + + AstUtils.ArgType ( control = control, - table = AstUtils.Table(?defaultValueSummary = defaultValue), + table = AstUtils.Table (typSummary = "string", ?defaultValueSummary = defaultValue), ?description = description - ) + ) | Regex -> - let control = - AstUtils.ControlType(typ = ControlType.Text) - AstUtils.ArgType( + let control = AstUtils.ControlType (typ = controlTypeDefault ControlType.Text) + + AstUtils.ArgType ( control = control, - table = AstUtils.Table( - typSummary = "Regex", - typDetail = "Expects valid regex", - ?defaultValueSummary = defaultValue - ), + table = AstUtils.Table (typSummary = "Regex", typDetail = "Expects valid regex", ?defaultValueSummary = defaultValue), ?description = description - ) + ) // todo - support enums | Type.Number (kind, info) -> let control = match kind with | Int8 -> - AstUtils.ControlType( + AstUtils.ControlType ( typ = ControlType.Number, - max = AstUtils.Value(int System.SByte.MaxValue), - min = AstUtils.Value(int System.SByte.MinValue), - step = AstUtils.Value(1)) + max = AstUtils.Value (int System.SByte.MaxValue), + min = AstUtils.Value (int System.SByte.MinValue), + step = AstUtils.Value (1) + ) | UInt8 -> - AstUtils.ControlType( + AstUtils.ControlType ( typ = ControlType.Number, - max = AstUtils.Value(int System.Byte.MaxValue), - min = AstUtils.Value(0), - step = AstUtils.Value(1) - ) + max = AstUtils.Value (int System.Byte.MaxValue), + min = AstUtils.Value (0), + step = AstUtils.Value (1) + ) | Int16 -> - AstUtils.ControlType( + AstUtils.ControlType ( typ = ControlType.Number, - max = AstUtils.Value(int System.Int16.MaxValue), - min = AstUtils.Value(int System.Int16.MinValue), - step = AstUtils.Value(1) - ) + max = AstUtils.Value (int System.Int16.MaxValue), + min = AstUtils.Value (int System.Int16.MinValue), + step = AstUtils.Value (1) + ) | UInt16 -> - AstUtils.ControlType( + AstUtils.ControlType ( typ = ControlType.Number, - max = AstUtils.Value(int System.UInt16.MaxValue), - min = AstUtils.Value(int System.UInt16.MinValue), - step = AstUtils.Value(1) - ) - | UInt64 -> - AstUtils.ControlType( + max = AstUtils.Value (int System.UInt16.MaxValue), + min = AstUtils.Value (int System.UInt16.MinValue), + step = AstUtils.Value (1) + ) + | UInt64 -> AstUtils.ControlType (typ = ControlType.Number, min = AstUtils.Value (0), step = AstUtils.Value (1)) + | UNativeInt + | UInt128 -> AstUtils.ControlType (typ = ControlType.Number, step = AstUtils.Value (1), min = AstUtils.Value (0)) + | Int128 + | NativeInt + | Int64 + | BigInt -> AstUtils.ControlType (typ = ControlType.Number, step = AstUtils.Value (1)) + | Float16 + | Float32 -> + AstUtils.ControlType ( typ = ControlType.Number, - min = AstUtils.Value(0), - step = AstUtils.Value(1) - ) - | UNativeInt | UInt128 -> - AstUtils.ControlType(typ = ControlType.Number, step = AstUtils.Value(1), min = AstUtils.Value(0)) - | Int128 | NativeInt | Int64 | BigInt -> - AstUtils.ControlType(typ = ControlType.Number, step = AstUtils.Value(1)) - | Float16 | Float32 -> - AstUtils.ControlType( - typ = ControlType.Number, - max = AstUtils.Value(float System.Single.MaxValue), - min = AstUtils.Value(float System.Single.MinValue) - ) - | Float64 | Decimal -> - AstUtils.ControlType( typ = ControlType.Number ) + max = AstUtils.Value (float System.Single.MaxValue), + min = AstUtils.Value (float System.Single.MinValue) + ) + | Float64 + | Decimal -> AstUtils.ControlType (typ = ControlType.Number) | Int32 -> - AstUtils.ControlType( + AstUtils.ControlType ( typ = ControlType.Number, - max = AstUtils.Value(int System.Int32.MaxValue), - min = AstUtils.Value(int System.Int32.MinValue), - step = AstUtils.Value(1) - ) + max = AstUtils.Value (int System.Int32.MaxValue), + min = AstUtils.Value (int System.Int32.MinValue), + step = AstUtils.Value (1) + ) | UInt32 -> - AstUtils.ControlType( + AstUtils.ControlType ( typ = ControlType.Number, - max = AstUtils.Value(int System.UInt32.MaxValue), - min = AstUtils.Value(0), - step = AstUtils.Value(1) - ) + max = AstUtils.Value (int System.UInt32.MaxValue), + min = AstUtils.Value (0), + step = AstUtils.Value (1) + ) - AstUtils.ArgType( + AstUtils.ArgType ( control = control, - table = AstUtils.Table( - typSummary = kind.ToString(), - ?defaultValueSummary = defaultValue - ), + table = AstUtils.Table (typSummary = kind.ToString().ToLower (), ?defaultValueSummary = defaultValue), ?description = description - ) + ) | Tuple (genArg, _) -> let tupleTyping = - genArg |> List.map _.ToString() |> String.concat ", " + genArg + |> List.map _.ToString() + |> String.concat ", " |> sprintf "Tuple ( %s )" - let control = AstUtils.ControlType(typ = ControlType.Object) - AstUtils.ArgType( + + let control = AstUtils.ControlType (typ = controlTypeDefault ControlType.Object) + + AstUtils.ArgType ( control = control, - table = AstUtils.Table( - typSummary = tupleTyping, - ?defaultValueSummary = defaultValue - ), + table = AstUtils.Table (typSummary = tupleTyping, ?defaultValueSummary = defaultValue), ?description = description - ) + ) | List genArg | Array (genArg, _) -> - let arrayTyping = genArg.ToString() |> sprintf "Array of %s" - let control = AstUtils.ControlType(typ = ControlType.Object) - AstUtils.ArgType( + let arrayTyping = + genArg.ToString () + |> sprintf "Array of %s" + + let control = AstUtils.ControlType (typ = controlTypeDefault ControlType.Object) + + AstUtils.ArgType ( control = control, - table = AstUtils.Table( - typSummary = arrayTyping, - ?defaultValueSummary = defaultValue - ), + table = AstUtils.Table (typSummary = arrayTyping, ?defaultValueSummary = defaultValue), ?description = description - ) - | Nullable (genArg, _) | Option (genArg, _) -> makeArgType genArg - | LambdaType _ | DelegateType _ -> - let control = AstUtils.ControlType(doNotRender = true) - AstUtils.ArgType( + ) + | Nullable (genArg, _) + | Option (genArg, _) -> makeArgType genArg + | LambdaType _ + | DelegateType _ -> + let control = AstUtils.ControlType (doNotRender = true) + + AstUtils.ArgType ( control = control, - table = AstUtils.Table( - typSummary = "function", - ?defaultValueSummary = defaultValue + table = + AstUtils.Table ( + typSummary = "function", + // typDetail =( + // match typ with + // | LambdaType(argType, returnType) -> + // $"{argType} -> {returnType}" + // | DelegateType(argTypes, returnType) -> + // argTypes + // |> List.map _.ToString() + // |> String.concat " * " + // |> fun args -> + // $"{args} -> {returnType}" + // | _ -> "" + // ), + ?defaultValueSummary = defaultValue ), ?description = description - ) + ) | GenericParam (name, isMeasure, constraints) -> - let control = AstUtils.ControlType(doNotRender = true) - AstUtils.ArgType( + let control = AstUtils.ControlType (doNotRender = true) + + AstUtils.ArgType ( control = control, - table = AstUtils.Table( - typSummary = $"GenericParam {name}", - ?defaultValueSummary = defaultValue - ), + table = AstUtils.Table (typSummary = $"GenericParam {name}", ?defaultValueSummary = defaultValue), ?description = description - ) + ) | DeclaredType (ref, genArgs) -> let entity = ctx.Helper.GetEntity ref + if entity.IsFSharpRecord then let typName = entity.FSharpFields - |> List.map (fun field -> - $"{field.Name}: {field.FieldType}" - ) + |> List.map (fun field -> $"{field.Name}: {field.FieldType}") |> String.concat ", " |> sprintf "{ %s }" - let control = AstUtils.ControlType(typ = ControlType.Object) - AstUtils.ArgType( + + let control = AstUtils.ControlType (typ = controlTypeDefault ControlType.Object) + + AstUtils.ArgType ( control = control, - table = AstUtils.Table( - typSummary = "Object", - typDetail = typName, - ?defaultValueSummary = defaultValue - ), + table = AstUtils.Table (typSummary = "Object", typDetail = typName, ?defaultValueSummary = defaultValue), ?description = description - ) + ) // elif entity.IsFSharpUnion then - // TODO + // TODO else - let control = AstUtils.ControlType(typ = ControlType.Object) - AstUtils.ArgType( - control = control, - table = AstUtils.Table( - typSummary = ref.DisplayName, - ?typDetail = ref.SourcePath, - ?defaultValueSummary = defaultValue - ), - ?description = description + let control = AstUtils.ControlType (typ = controlTypeDefault ControlType.Object) + + AstUtils.ArgType ( + control = control, + table = + AstUtils.Table (typSummary = ref.DisplayName, ?typDetail = ref.SourcePath, ?defaultValueSummary = defaultValue), + ?description = description ) | AnonymousRecordType (fieldNames, genArgs, isStruct) -> - let control = AstUtils.ControlType(typ = ControlType.Object) + let control = AstUtils.ControlType (typ = controlTypeDefault ControlType.Object) + let typName = - fieldNames |> Array.toList + fieldNames + |> Array.toList |> List.zip genArgs - |> List.map(function - | typ,name -> - $"{name}: {typ}" - ) + |> List.map (function + | typ, name -> $"{name}: {typ}") |> String.concat ", " |> sprintf "{ %s }" - AstUtils.ArgType( + + AstUtils.ArgType ( control = control, - table = AstUtils.Table( - typSummary = "Object", - typDetail = typName, - ?defaultValueSummary = defaultValue - ), + table = AstUtils.Table (typSummary = "Object", typDetail = typName, ?defaultValueSummary = defaultValue), ?description = description - ) + ) | _ -> AstUtils.Unit + makeArgType prop.Type |> fun expr -> - let name = prop.Name |> StringUtils.TrimReservedIdentifiers - { - Name = name - Arg = - let maybeArg = args |> List.tryFind (fst >> StringUtils.TrimReservedIdentifiers >> (=) name) |> Option.map snd - maybeArg - |> Option.orElse( - if (prop.Type.IsDelegateType || prop.Type.IsLambdaType) && (prop.Name.StartsWith "on" || docData.Storybook.Spy) then - Some <| AstUtils.Call(AstUtils.Import("fn", "storybook/test"), AstUtils.CallInfo()) - else None ) - ArgType = expr - XmlDocs = docs - } - ) + let name = + prop.Name + |> StringUtils.TrimReservedIdentifiers + + { Name = name + Arg = + let maybeArg = + args + |> List.tryFind ( + fst + >> StringUtils.TrimReservedIdentifiers + >> (=) name + ) + |> Option.map snd + + maybeArg + |> Option.orElse ( + if + (prop.Type.IsDelegateType + || prop.Type.IsLambdaType) + && (prop.Name.StartsWith "on" + || docData.Storybook.Spy) + then + Some + <| AstUtils.Call (AstUtils.Import ("fn", "storybook/test"), AstUtils.CallInfo ()) + else + None + ) + ArgType = expr + XmlDocs = docs }) // The closing macro string for valid jsx when considering what fable will push at // the end let closeLastTemplate = "\nconst $PARTAS_DISCARD = { $discard: true" @@ -857,65 +1229,83 @@ module internal StorybookAST = If we don't create the macro string with the idents of the exports embedded, then we end up generating string idents (if they are passed as values to the macro as usual).*) let compExpr = - AstUtils.Emit( - [ - $"$0\n }};\n\nexport default {memberDecl.Name};\n" - yield! (variants |> List.mapi (fun idx (Variant(name,_)) -> - $"export const {name} = ${idx + 2}" ) ) - closeLastTemplate - ] |> String.concat "\n", - AstUtils.CallInfo(args = [ - getComponentExprFromEntity ctx entity - AstUtils.Value (memberDecl.Name |> StringUtils.TrimReservedIdentifiers) - yield! ( - variants |> List.map (fun (Variant (_,expr)) -> - AstUtils.Object([ - "args", AstUtils.Object(expr) - ]) - ) - ) - ]) + AstUtils.Emit ( + [ $"$0\n }};\n\nexport default {memberDecl.Name};\n" + yield! + (variantCombinations + |> List.mapi (fun idx (name, _) -> $"export const {name} = ${idx + 2}")) + closeLastTemplate ] + |> String.concat "\n", + AstUtils.CallInfo ( + args = + [ getComponentExprFromEntity ctx entity + AstUtils.Value ( + memberDecl.Name + |> StringUtils.TrimReservedIdentifiers + ) + yield! + (variantCombinations + |> List.map snd) ] ) - let argNames = args |> List.map (function name,expr -> name |> StringUtils.TrimReservedIdentifiers, expr) - [ - "args", - fieldData - |> List.choose(fun data -> - argNames - |> List.tryFind (fst >> (=) data.Name) - |> function - | Some (_, expr) -> - Some(data.Name, expr) - | None when data.Arg.IsSome -> - Some(data.Name, data.Arg.Value) - | _ -> None - ) - |> AstUtils.Object - "argTypes", AstUtils.Object (fieldData |> List.map (function { Name = name; ArgType = expr } -> name,expr)) - if render.IsSome then - "render", render.Value - "component", compExpr - ] |> AstUtils.Object + ) + + let argNames = + args + |> List.map (function + | name, expr -> + name + |> StringUtils.TrimReservedIdentifiers, + expr) + + [ "args", + fieldData + |> List.choose (fun data -> + argNames + |> List.tryFind ( + fst + >> (=) data.Name + ) + |> function + | Some (_, expr) -> Some (data.Name, expr) + | None when data.Arg.IsSome -> Some (data.Name, data.Arg.Value) + | _ -> None) + |> AstUtils.Object + "argTypes", + AstUtils.Object ( + fieldData + |> List.map (function + | { Name = name; ArgType = expr } -> name, expr) + ) + if render.IsSome then + "render", render.Value + "component", compExpr ] + |> AstUtils.Object |> fun expr -> match memberDecl with | { XmlDoc = None | Some "" } -> - { memberDecl with XmlDoc = entityXmlDocs } + { memberDecl with + XmlDoc = entityXmlDocs } | _ -> memberDecl - |> function memberDecl -> { memberDecl with Body = expr } + |> function + | memberDecl -> { memberDecl with Body = expr } [] - let rec (|RootExpr|_|) ctx = function - | Call(callee=(Import(info = { Selector = StartsWith "StorybookExtensions_Run" }))) as expr -> - ValueSome expr + let rec (|RootExpr|_|) ctx = + function + | Call (callee = (Import (info = { Selector = StartsWith "StorybookExtensions_Run" }))) as expr -> ValueSome expr | _ -> ValueNone let transform (ctx: PluginContext) (memberDecl: MemberDecl) = - let predicate = function RootExpr ctx _ -> true | _ -> false + let predicate = + function + | RootExpr ctx _ -> true + | _ -> false + let expr = memberDecl.Body + findAndDiscardElse predicate expr |> function - | [ expr ]-> - createMeta ctx memberDecl expr + | [ expr ] -> createMeta ctx memberDecl expr | _ -> failwith $"Unexpected content {expr}" @@ -924,17 +1314,19 @@ module internal StorybookAST = type PartasStorybookAttribute(compFlags: int) = inherit MemberDeclarationPluginAttribute() let flags = enum compFlags + override this.Transform(pluginHelper, file, memberDecl) = let ctx = PluginContext.create pluginHelper TransformationKind.MemberDecl flags - if flags.HasFlag(ComponentFlag.DebugMode) then + + if flags.HasFlag (ComponentFlag.DebugMode) then memberDecl.Body |> printfn "START MEMBER DECL!!!\n%A\nEND MEMBER DECL!!!" + memberDecl |> StorybookAST.transform ctx - override this.TransformCall(_, _, expr) = - expr + override this.TransformCall(_, _, expr) = expr override this.FableMinimumVersion = "5.0" - new() = PartasStorybookAttribute(int ComponentFlag.Default) - new(componentFlag: ComponentFlag) = PartasStorybookAttribute(int componentFlag) + new() = PartasStorybookAttribute (int ComponentFlag.Default) + new(componentFlag: ComponentFlag) = PartasStorybookAttribute (int componentFlag) diff --git a/Partas.Solid.FablePlugin/Utils.fs b/Partas.Solid.FablePlugin/Utils.fs index b734159..027163e 100644 --- a/Partas.Solid.FablePlugin/Utils.fs +++ b/Partas.Solid.FablePlugin/Utils.fs @@ -383,102 +383,102 @@ module Patterns = module Expr = - let rec findAndDiscardElse (predicate: Expr -> bool): Expr -> Expr list = - let filterList (values: Expr list): Expr list = + let rec findAndDiscardElse (predicate: Expr -> bool) : Expr -> Expr list = + let filterList (values: Expr list) : Expr list = List.collect (findAndDiscardElse predicate) values + function | expr when predicate expr -> [ expr ] - | Expr.Call(callee = expr; info = { Args = exprs }) -> - expr :: exprs + | Expr.Call (callee = expr; info = { Args = exprs }) -> + expr + :: exprs |> filterList - | Expr.CurriedApply(applied= expr; args = exprs) -> - expr :: exprs + | Expr.CurriedApply (applied = expr; args = exprs) -> + expr + :: exprs |> filterList - | Expr.DecisionTree(expr=expr; targets = targets) -> - expr :: List.map snd targets + | Expr.DecisionTree (expr = expr; targets = targets) -> + expr + :: List.map snd targets |> filterList - | Expr.DecisionTreeSuccess(boundValues = exprs) -> - filterList exprs - | Expr.Delegate(body = expr) -> - findAndDiscardElse predicate expr - | Expr.Emit(info = { CallInfo = { Args = exprs } }) -> - filterList exprs - | Expr.ForLoop(start = start; body = body; limit = limit) -> + | Expr.DecisionTreeSuccess (boundValues = exprs) -> filterList exprs + | Expr.Delegate (body = expr) -> findAndDiscardElse predicate expr + | Expr.Emit (info = { CallInfo = { Args = exprs } }) -> filterList exprs + | Expr.ForLoop (start = start; body = body; limit = limit) -> [ start; body; limit ] |> filterList - | Expr.Get(expr = expr; kind = getKind) -> + | Expr.Get (expr = expr; kind = getKind) -> let maybeResult = findAndDiscardElse predicate expr - if maybeResult.IsEmpty |> not then maybeResult + + if + maybeResult.IsEmpty + |> not + then + maybeResult else - match getKind with - | ExprGet expr -> - findAndDiscardElse predicate expr - | _ -> maybeResult - | Expr.IfThenElse(guardExpr = guardExpr; elseExpr = elseExpr; thenExpr = thenExpr) -> + match getKind with + | ExprGet expr -> findAndDiscardElse predicate expr + | _ -> maybeResult + | Expr.IfThenElse (guardExpr = guardExpr; elseExpr = elseExpr; thenExpr = thenExpr) -> [ guardExpr; elseExpr; thenExpr ] |> filterList - | Expr.Lambda(body = expr) -> - findAndDiscardElse predicate expr - | Expr.Let(body = body; value = value) -> - filterList [ body; value ] - | Expr.LetRec(bindings = bindings; body = body) -> - body :: List.map snd bindings + | Expr.Lambda (body = expr) -> findAndDiscardElse predicate expr + | Expr.Let (body = body; value = value) -> filterList [ body; value ] + | Expr.LetRec (bindings = bindings; body = body) -> + body + :: List.map snd bindings |> filterList - | Expr.ObjectExpr(baseCall = exprMaybe; members = members) -> - members |> List.map _.Body - |> List.append [ if exprMaybe.IsSome then exprMaybe.Value ] + | Expr.ObjectExpr (baseCall = exprMaybe; members = members) -> + members + |> List.map _.Body + |> List.append + [ if exprMaybe.IsSome then + exprMaybe.Value ] |> filterList - | Expr.Operation(kind = OperationKind.Binary(left = left; right = right)) - | Expr.Operation(kind = OperationKind.Logical(left = left; right = right)) -> + | Expr.Operation (kind = OperationKind.Binary (left = left; right = right)) + | Expr.Operation (kind = OperationKind.Logical (left = left; right = right)) -> [ left; right ] |> filterList - | Expr.Operation(kind = OperationKind.Unary(operand = expr)) -> - findAndDiscardElse predicate expr - | Expr.Sequential exprs -> - filterList exprs - | Expr.Set(expr = expr; value = value; kind = kind) -> + | Expr.Operation (kind = OperationKind.Unary (operand = expr)) -> findAndDiscardElse predicate expr + | Expr.Sequential exprs -> filterList exprs + | Expr.Set (expr = expr; value = value; kind = kind) -> match kind with | ExprSet exprSet -> [ expr; value; exprSet ] |> filterList - | _ -> [ expr;value ] |> filterList - | Expr.TryCatch(body = expr; catch = catch; finalizer = finalizer) -> - [ - expr - match catch with - | Some(_,value) -> value - | _ -> () - match finalizer with - | Some value -> value - | _ -> () - ] + | _ -> + [ expr; value ] + |> filterList + | Expr.TryCatch (body = expr; catch = catch; finalizer = finalizer) -> + [ expr + match catch with + | Some (_, value) -> value + | _ -> () + match finalizer with + | Some value -> value + | _ -> () ] |> filterList - | Expr.TypeCast(expr = expr) -> findAndDiscardElse predicate expr - | Expr.Value(kind = kind) -> + | Expr.TypeCast (expr = expr) -> findAndDiscardElse predicate expr + | Expr.Value (kind = kind) -> match kind with - | ValueKind.NewAnonymousRecord(values = exprs) -> - filterList exprs - | NewArray(newKind = NewArrayKind.ArrayAlloc expr) -> - findAndDiscardElse predicate expr - | NewArray(newKind = NewArrayKind.ArrayFrom expr) -> - findAndDiscardElse predicate expr - | NewArray(newKind = NewArrayKind.ArrayValues exprs) -> - filterList exprs - | NewList(headAndTail = Some (head,tail)) -> + | ValueKind.NewAnonymousRecord (values = exprs) -> filterList exprs + | NewArray (newKind = NewArrayKind.ArrayAlloc expr) -> findAndDiscardElse predicate expr + | NewArray (newKind = NewArrayKind.ArrayFrom expr) -> findAndDiscardElse predicate expr + | NewArray (newKind = NewArrayKind.ArrayValues exprs) -> filterList exprs + | NewList (headAndTail = Some (head, tail)) -> [ head; tail ] |> filterList - | NewOption(value = Some expr) -> - findAndDiscardElse predicate expr - | NewTuple(values = exprs) - | NewUnion(values = exprs) - | StringTemplate(values = exprs; tag = None) - | NewRecord(values = exprs) -> - filterList exprs - | StringTemplate(values = exprs; tag = Some expr) -> - expr :: exprs + | NewOption (value = Some expr) -> findAndDiscardElse predicate expr + | NewTuple (values = exprs) + | NewUnion (values = exprs) + | StringTemplate (values = exprs; tag = None) + | NewRecord (values = exprs) -> filterList exprs + | StringTemplate (values = exprs; tag = Some expr) -> + expr + :: exprs |> filterList | _ -> [] - | Expr.WhileLoop(body = body; guard = guard) -> + | Expr.WhileLoop (body = body; guard = guard) -> [ guard; body ] |> filterList | _ -> [] diff --git a/Partas.Solid/Partas.Solid.fsproj b/Partas.Solid/Partas.Solid.fsproj index b3000a6..2c1d628 100644 --- a/Partas.Solid/Partas.Solid.fsproj +++ b/Partas.Solid/Partas.Solid.fsproj @@ -16,8 +16,8 @@ Shayan Habibi, Vladimir Schur and Contributors Copyright (c) Shayan Habibi 2025, based on work by Vladimir Schur 2024 README.md - 2.1.0-alpha.3 - 2.1.0-alpha.3 + 2.1.0-alpha.4 + 2.1.0-alpha.4 diff --git a/Partas.Solid/Storybook.fs b/Partas.Solid/Storybook.fs index cc51b4d..b7a84b2 100644 --- a/Partas.Solid/Storybook.fs +++ b/Partas.Solid/Storybook.fs @@ -11,52 +11,105 @@ module Builder = type StorybookArgs<'T> = interface end type StorybookFun<'T> = Storybook<'T> -> unit type StorybookArgsFun<'T> = StorybookArgs<'T> -> unit + type Storybook<'T> with - member inline _.Combine([] PARTAS_FIRST: StorybookFun<'T>, [] PARTAS_SECOND: StorybookFun<'T>): StorybookFun<'T> = + member inline _.Combine + ([] PARTAS_FIRST: StorybookFun<'T>, [] PARTAS_SECOND: StorybookFun<'T>) + : StorybookFun<'T> = fun PARTAS_BUILDER -> PARTAS_FIRST PARTAS_BUILDER PARTAS_SECOND PARTAS_BUILDER - member inline _.Zero(): StorybookFun<'T> = ignore - member inline _.Yield(_: unit): StorybookFun<'T> = ignore - member inline _.Delay([] PARTAS_DELAY: unit -> StorybookFun<'T>): StorybookFun<'T> = PARTAS_DELAY() - member inline _.Yield([] PARTAS_ELEMENT: 'T -> 'Value): StorybookFun<'T> = fun PARTAS_YIELD -> ignore PARTAS_ELEMENT - member inline _.Yield(PARTAS_VALUE: StorybookArgs<'T>): StorybookFun<'T> = fun PARTAS_YIELD -> ignore PARTAS_VALUE + + member inline _.Zero() : StorybookFun<'T> = ignore + member inline _.Yield(_: unit) : StorybookFun<'T> = ignore + + member inline _.Delay([] PARTAS_DELAY: unit -> StorybookFun<'T>) : StorybookFun<'T> = + PARTAS_DELAY () + + member inline _.Yield([] PARTAS_ELEMENT: 'T -> 'Value) : StorybookFun<'T> = + fun PARTAS_YIELD -> ignore PARTAS_ELEMENT + + member inline _.Yield(PARTAS_VALUE: StorybookArgs<'T>) : StorybookFun<'T> = + fun PARTAS_YIELD -> ignore PARTAS_VALUE + [] - member inline _.Cases([] PARTAS_FIRST: StorybookFun<'T>, PARTAS_CASES: ('T -> obj)): StorybookFun<'T> = fun PARTAS_BUILDER -> - ignore PARTAS_CASES - PARTAS_FIRST PARTAS_BUILDER + member inline _.Cases([] PARTAS_FIRST: StorybookFun<'T>, PARTAS_CASES: ('T -> obj)) : StorybookFun<'T> = + fun PARTAS_BUILDER -> + ignore PARTAS_CASES + PARTAS_FIRST PARTAS_BUILDER + [] - member inline _.Args([] PARTAS_FIRST: StorybookFun<'T>, [] PARTAS_ARGS: ('T -> unit)): StorybookFun<'T> = fun PARTAS_BUILDER -> - ignore PARTAS_ARGS - PARTAS_FIRST PARTAS_BUILDER + member inline _.Args([] PARTAS_FIRST: StorybookFun<'T>, [] PARTAS_ARGS: ('T -> unit)) : StorybookFun<'T> = + fun PARTAS_BUILDER -> + ignore PARTAS_ARGS + PARTAS_FIRST PARTAS_BUILDER + [] - member inline _.Args([] PARTAS_FIRST: StorybookFun<'T>, PARTAS_VARIANT: string, [] PARTAS_VARIANT_ARGS: ('T -> unit)): StorybookFun<'T> = fun PARTAS_BUILDER -> - ignore ("PARTAS_VARIANT" + PARTAS_VARIANT) - ignore PARTAS_VARIANT_ARGS - PARTAS_FIRST PARTAS_BUILDER - member inline _.For([] PARTAS_FIRST: StorybookFun<'T>, [] PARTAS_SECOND: unit -> StorybookFun<'T>): StorybookFun<'T> = + member inline _.Args + ([] PARTAS_FIRST: StorybookFun<'T>, PARTAS_VARIANT: string, [] PARTAS_VARIANT_ARGS: ('T -> unit)) + : StorybookFun<'T> = + fun PARTAS_BUILDER -> + ignore ( + "PARTAS_VARIANT" + + PARTAS_VARIANT + ) + + ignore PARTAS_VARIANT_ARGS + PARTAS_FIRST PARTAS_BUILDER + + member inline _.For + ([] PARTAS_FIRST: StorybookFun<'T>, [] PARTAS_SECOND: unit -> StorybookFun<'T>) + : StorybookFun<'T> = fun PARTAS_BUILDER -> PARTAS_FIRST PARTAS_BUILDER PARTAS_SECOND () PARTAS_BUILDER + [] - member inline _.Render([] PARTAS_FIRST: StorybookFun<'T>, [] PARTAS_RENDER: 'T -> #Partas.Solid.Builder.HtmlElement): StorybookFun<'T> = + member inline _.Render + ([] PARTAS_FIRST: StorybookFun<'T>, [] PARTAS_RENDER: 'T -> #Partas.Solid.Builder.HtmlElement) + : StorybookFun<'T> = fun PARTAS_BUILDER -> ignore PARTAS_RENDER PARTAS_FIRST PARTAS_BUILDER + + [] + member inline _.Render + ( + [] PARTAS_FIRST: StorybookFun<'T>, + PARTAS_RENDER_VARIANT: string, + [] PARTAS_VARIANT_RENDER: 'T -> #Partas.Solid.Builder.HtmlElement + ) : StorybookFun<'T> = + fun PARTAS_BUILDER -> + ignore ( + "PARTAS_RENDER_VARIANT" + + PARTAS_RENDER_VARIANT + ) + + ignore PARTAS_VARIANT_RENDER + PARTAS_FIRST PARTAS_BUILDER + type StorybookArgs<'T> with - member inline _.Combine([] PARTAS_FIRST: StorybookArgsFun<'T>, [] PARTAS_SECOND: StorybookArgsFun<'T>): StorybookArgsFun<'T> = + member inline _.Combine + ([] PARTAS_FIRST: StorybookArgsFun<'T>, [] PARTAS_SECOND: StorybookArgsFun<'T>) + : StorybookArgsFun<'T> = fun PARTAS_BUILDER -> PARTAS_FIRST PARTAS_BUILDER PARTAS_SECOND PARTAS_BUILDER - member inline _.Zero(): StorybookArgsFun<'T> = ignore - member inline _.Delay([] PARTAS_DELAY: unit -> StorybookArgsFun<'T>): StorybookArgsFun<'T> = PARTAS_DELAY() - member inline _.Yield(PARTAS_VALUE: ('T -> 'Value) * ('Value)): StorybookArgsFun<'T> = fun PARTAS_YIELD -> ignore PARTAS_VALUE + + member inline _.Zero() : StorybookArgsFun<'T> = ignore + + member inline _.Delay([] PARTAS_DELAY: unit -> StorybookArgsFun<'T>) : StorybookArgsFun<'T> = + PARTAS_DELAY () + + member inline _.Yield(PARTAS_VALUE: ('T -> 'Value) * ('Value)) : StorybookArgsFun<'T> = + fun PARTAS_YIELD -> ignore PARTAS_VALUE type StorybookExtensions = [] static member Run(PARTAS_THIS: Storybook<'T>, PARTAS_RUN: StorybookFun<'T>) = PARTAS_RUN PARTAS_THIS PARTAS_THIS + [] static member Run(PARTAS_THIS: StorybookArgs<'T>, PARTAS_RUN: StorybookArgsFun<'T>) = PARTAS_RUN PARTAS_THIS From 49a8354d84cfb9226b964eebdc772f5f03362c71 Mon Sep 17 00:00:00 2001 From: cabboose Date: Fri, 5 Sep 2025 23:31:53 +0800 Subject: [PATCH 05/13] fix fantomas break --- Partas.Solid.FablePlugin/Storybook.fs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/Partas.Solid.FablePlugin/Storybook.fs b/Partas.Solid.FablePlugin/Storybook.fs index 9cac540..48656f3 100644 --- a/Partas.Solid.FablePlugin/Storybook.fs +++ b/Partas.Solid.FablePlugin/Storybook.fs @@ -926,8 +926,11 @@ module internal StorybookAST = _.ToLower() >> (=) "false" ) - || (controlTypeAttribute - |> Option.exists (_.ToLower().StartsWith ("hide"))) } } + || ((controlTypeAttribute: string option) + |> Option.exists ( + _.ToLower() + >> _.StartsWith("hide") + )) } } let defaultValue = docData.DefaultValue let description = docData.Summary From 9b92429d17197868b07e6849683afb31b0b8e408 Mon Sep 17 00:00:00 2001 From: cabboose Date: Sat, 6 Sep 2025 15:16:54 +0800 Subject: [PATCH 06/13] Remove jetbrains language injection attributes to determine if they are preventing tailwind injection by the tailwind language service --- Partas.Solid/HtmlAttributes.fs | 557 ++++++++++++++++++--------------- 1 file changed, 308 insertions(+), 249 deletions(-) diff --git a/Partas.Solid/HtmlAttributes.fs b/Partas.Solid/HtmlAttributes.fs index ea60c46..280c3a3 100644 --- a/Partas.Solid/HtmlAttributes.fs +++ b/Partas.Solid/HtmlAttributes.fs @@ -11,7 +11,9 @@ open Partas.Solid.Experimental.U module HtmlAttributes = type HtmlContainer with [] - member _.children: HtmlElement = jsNative + member _.children + with set(value: HtmlElement) = JS.undefined + and get(): HtmlElement = JS.undefined type HTMLAttributes with [] @@ -475,62 +477,74 @@ module HtmlAttributes = with set (value: WheelEvent -> unit) = () and [] get (): WheelEvent -> unit = unbox () - [] + // [] + [] member _.class' with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.accessKey with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.contenteditable with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.contextmenu with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.dir with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.draggable with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.hidden with set (_: U2) = () and [] get (): U2 = unbox () - [] + // [] + [] member _.id with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.is with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.inert with set (_: bool) = () and [] get (): bool = unbox () - [] + // [] + [] member _.lang with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.spellcheck with set (_: bool) = () and [] get (): bool = unbox () @@ -540,228 +554,273 @@ module HtmlAttributes = with set (_: obj) = () and get (): obj = unbox () - [] + // [] + [] member this.style with inline set (value: string) = this.style'' <- value and inline [] get (): string = !!this.style'' - [] + // [] + [] member _.tabindex with set (_: int) = () and [] get (): int = unbox () - [] + // [] + [] member _.title with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.translate with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.about with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.datatype with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.inlist with set (_: obj) = () and [] get () = unbox () - [] + // [] + [] member _.popover with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.prefix with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.property with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.resource with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.typeof with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.vocab with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.autocapitalize with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.slot with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.color with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.itemprop with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.itemscope with set (_: bool) = () and [] get (): bool = unbox () - [] + // [] + [] member _.itemtype with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.itemid with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.itemref with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.part with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.exportparts with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.inputmode with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.contentEditable with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.contextMenu with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.tabIndex with set (_: int) = () and [] get (): int = unbox () - [] + // [] + [] member _.autoCapitalize with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.itemProp with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.itemScope with set (_: bool) = () and [] get (): bool = unbox () - [] + // [] + [] member _.itemType with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.itemId with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.itemRef with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.exportParts with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.inputMode with set (_: string) = () and [] get (): string = unbox () type AnchorHTMLAttributes with - [] + // [] + [] member _.download with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.href with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.hreflang with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.media with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.ping with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.referrerpolicy with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.rel with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.target with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.type' with set (_: string) = () and [] get (): string = unbox () - [] + // [] + [] member _.referrerPolicy with set (_: string) = () and [] get (): string = unbox () @@ -770,67 +829,67 @@ module HtmlAttributes = type AreaHTMLAttributes with [] - [] +// [] member _.alt with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.coords with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.download with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.href with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.hreflang with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.ping with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.referrerpolicy with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.rel with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.shape with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.target with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.referrerPolicy with set (_: string) = () and [] get (): string = unbox () @@ -838,13 +897,13 @@ module HtmlAttributes = type BaseHTMLAttributes with [] - [] +// [] member _.href with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.target with set (_: string) = () and [] get (): string = unbox () @@ -852,7 +911,7 @@ module HtmlAttributes = type BlockquoteHTMLAttributes with [] - [] +// [] member _.cite with set (_: string) = () and [] get (): string = unbox () @@ -870,7 +929,7 @@ module HtmlAttributes = and [] get (): bool = unbox () [] - [] +// [] member _.form with set (_: string) = () and [] get (): string = unbox () @@ -881,55 +940,55 @@ module HtmlAttributes = and [] get (): bool = unbox () [] - [] +// [] member _.name with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.type' with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.value with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.formAction with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.formEnctype with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.formMethod with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.formTarget with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.popoverTarget with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.popoverTargetAction with set (_: string) = () and [] get (): string = unbox () @@ -968,7 +1027,7 @@ module HtmlAttributes = type DataHTMLAttributes with [] - [] +// [] member _.value with set (_: string) = () and [] get (): string = unbox () @@ -1010,13 +1069,13 @@ module HtmlAttributes = and [] get (): int = unbox () [] - [] +// [] member _.src with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.type' with set (_: string) = () and [] get (): string = unbox () @@ -1034,13 +1093,13 @@ module HtmlAttributes = and [] get (): bool = unbox () [] - [] +// [] member _.form with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.name with set (_: string) = () and [] get (): string = unbox () @@ -1048,55 +1107,55 @@ module HtmlAttributes = type FormHTMLAttributes with [] - [] +// [] member _.accept with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.action with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.autocomplete with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.encoding with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.enctype with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.method with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.name with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.noValidate with set (_: bool) = () and [] get (): bool = unbox () [] - [] +// [] member _.target with set (_: string) = () and [] get (): string = unbox () @@ -1105,13 +1164,13 @@ module HtmlAttributes = type IframeHTMLAttributes with [] - [] +// [] member _.allow with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.allowfullscreen with set (_: string) = () and [] get (): string = unbox () @@ -1122,37 +1181,37 @@ module HtmlAttributes = and [] get (): int = unbox () [] - [] +// [] member _.loading with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.name with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.referrerpolicy with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.sandbox with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.src with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.srcdoc with set (_: string) = () and [] get (): string = unbox () @@ -1163,7 +1222,7 @@ module HtmlAttributes = and [] get (): int = unbox () [] - [] +// [] member _.referrerPolicy with set (_: string) = () and [] get (): string = unbox () @@ -1171,19 +1230,19 @@ module HtmlAttributes = type ImgHTMLAttributes with [] - [] +// [] member _.alt with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.crossorigin with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.decoding with set (_: string) = () and [] get (): string = unbox () @@ -1199,55 +1258,55 @@ module HtmlAttributes = and [] get (): bool = unbox () [] - [] +// [] member _.loading with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.referrerpolicy with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.referrerPolicy with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.sizes with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.src with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.srcset with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.srcSet with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.usemap with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.useMap with set (_: string) = () and [] get (): string = unbox () @@ -1258,19 +1317,19 @@ module HtmlAttributes = and [] get (): int = unbox () [] - [] +// [] member _.crossOrigin with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.elementtiming with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.fetchpriority with set (_: string) = () and [] get (): string = unbox () @@ -1278,25 +1337,25 @@ module HtmlAttributes = type InputHTMLAttributes with [] - [] +// [] member _.accept with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.alt with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.autocomplete with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.autocorrect with set (_: string) = () and [] get (): string = unbox () @@ -1307,7 +1366,7 @@ module HtmlAttributes = and [] get (): bool = unbox () [] - [] +// [] member _.capture with set (_: string) = () and [] get (): string = unbox () @@ -1318,25 +1377,25 @@ module HtmlAttributes = and [] get (): bool = unbox () [] - [] +// [] member _.crossorigin with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.disabled with set (_: bool) = () and [] get (): bool = unbox () [] - [] +// [] member _.enterkeyhint with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.form with set (_: string) = () and [] get (): string = unbox () @@ -1347,7 +1406,7 @@ module HtmlAttributes = and [] get (): bool = unbox () [] - [] +// [] member _.formtarget with set (_: string) = () and [] get (): string = unbox () @@ -1358,13 +1417,13 @@ module HtmlAttributes = and [] get (): int = unbox () [] - [] +// [] member _.incremental with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.list with set (_: string) = () and [] get (): string = unbox () @@ -1395,19 +1454,19 @@ module HtmlAttributes = and [] get (): bool = unbox () [] - [] +// [] member _.name with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.pattern with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.placeholder with set (_: string) = () and [] get (): string = unbox () @@ -1418,7 +1477,7 @@ module HtmlAttributes = and [] get (): bool = unbox () [] - [] +// [] member _.results with set (_: string) = () and [] get (): string = unbox () @@ -1434,25 +1493,25 @@ module HtmlAttributes = and [] get (): int = unbox () [] - [] +// [] member _.src with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.step with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.type' with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.value with set (_: string) = () and [] get (): string = unbox () @@ -1463,25 +1522,25 @@ module HtmlAttributes = and [] get (): int = unbox () [] - [] +// [] member _.crossOrigin with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.formAction with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.formEnctype with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.formMethod with set (_: string) = () and [] get (): string = unbox () @@ -1492,7 +1551,7 @@ module HtmlAttributes = and [] get (): bool = unbox () [] - [] +// [] member _.formTarget with set (_: string) = () and [] get (): string = unbox () @@ -1515,13 +1574,13 @@ module HtmlAttributes = type InsHTMLAttributes with [] - [] +// [] member _.cite with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.dateTime with set (_: string) = () and [] get (): string = unbox () @@ -1534,7 +1593,7 @@ module HtmlAttributes = and [] get (): bool = unbox () [] - [] +// [] member _.challenge with set (_: string) = () and [] get (): string = unbox () @@ -1545,25 +1604,25 @@ module HtmlAttributes = and [] get (): bool = unbox () [] - [] +// [] member _.form with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.keytype with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.keyparams with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.name with set (_: string) = () and [] get (): string = unbox () @@ -1571,13 +1630,13 @@ module HtmlAttributes = type LabelHTMLAttributes with [] - [] +// [] member _.for' with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.form with set (_: string) = () and [] get (): string = unbox () @@ -1585,7 +1644,7 @@ module HtmlAttributes = type LiHTMLAttributes with [] - [] +// [] member _.value with set (_: string) = () and [] get (): string = unbox () @@ -1593,13 +1652,13 @@ module HtmlAttributes = type LinkHTMLAttributes with [] - [] +// [] member _.as' with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.crossorigin with set (_: string) = () and [] get (): string = unbox () @@ -1610,79 +1669,79 @@ module HtmlAttributes = and [] get (): bool = unbox () [] - [] +// [] member _.fetchpriority with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.href with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.hreflang with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.imagesizes with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.imagesrcset with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.integrity with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.media with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.referrerpolicy with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.rel with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.sizes with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.type' with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.crossOrigin with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.referrerPolicy with set (_: string) = () and [] get (): string = unbox () @@ -1690,7 +1749,7 @@ module HtmlAttributes = type MapHTMLAttributes with [] - [] +// [] member _.name with set (_: string) = () and [] get (): string = unbox () @@ -1708,13 +1767,13 @@ module HtmlAttributes = and [] get (): bool = unbox () [] - [] +// [] member _.controlslist with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.crossorigin with set (_: string) = () and [] get (): string = unbox () @@ -1725,7 +1784,7 @@ module HtmlAttributes = and [] get (): bool = unbox () [] - [] +// [] member _.mediagroup with set (_: string) = () and [] get (): string = unbox () @@ -1736,25 +1795,25 @@ module HtmlAttributes = and [] get (): bool = unbox () [] - [] +// [] member _.preload with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.src with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.crossOrigin with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.mediaGroup with set (_: string) = () and [] get (): string = unbox () @@ -1762,44 +1821,44 @@ module HtmlAttributes = type MenuHTMLAttributes with [] - [] +// [] member _.label with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.type' with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.charset with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.content with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.http with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.name with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.media with set (_: string) = () and [] get (): string = unbox () @@ -1807,7 +1866,7 @@ module HtmlAttributes = type MeterHTMLAttributes with [] - [] +// [] member _.form with set (_: string) = () and [] get (): string = unbox () @@ -1845,7 +1904,7 @@ module HtmlAttributes = type QuoteHTMLAttributes with [] - [] +// [] member _.cite with set (_: string) = () and [] get (): string = unbox () @@ -1853,13 +1912,13 @@ module HtmlAttributes = type ObjectHTMLAttributes with [] - [] +// [] member _.data with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.form with set (_: string) = () and [] get (): string = unbox () @@ -1870,19 +1929,19 @@ module HtmlAttributes = and [] get (): int = unbox () [] - [] +// [] member _.name with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.type' with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.usemap with set (_: string) = () and [] get (): string = unbox () @@ -1893,7 +1952,7 @@ module HtmlAttributes = and [] get (): int = unbox () [] - [] +// [] member _.useMap with set (_: string) = () and [] get (): string = unbox () @@ -1901,19 +1960,19 @@ module HtmlAttributes = type OlHTMLAttributes with [] - [] +// [] member _.reversed with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.start with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.type' with set (_: string) = () and [] get (): string = unbox () @@ -1926,7 +1985,7 @@ module HtmlAttributes = and [] get (): bool = unbox () [] - [] +// [] member _.label with set (_: string) = () and [] get (): string = unbox () @@ -1939,7 +1998,7 @@ module HtmlAttributes = and [] get (): bool = unbox () [] - [] +// [] member _.label with set (_: string) = () and [] get (): string = unbox () @@ -1950,7 +2009,7 @@ module HtmlAttributes = and [] get (): bool = unbox () [] - [] +// [] member _.value with set (_: string) = () and [] get (): string = unbox () @@ -1958,19 +2017,19 @@ module HtmlAttributes = type OutputHTMLAttributes with [] - [] +// [] member _.form with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.for' with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.name with set (_: string) = () and [] get (): string = unbox () @@ -1978,13 +2037,13 @@ module HtmlAttributes = type ParamHTMLAttributes with [] - [] +// [] member _.name with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.value with set (_: string) = () and [] get (): string = unbox () @@ -1997,7 +2056,7 @@ module HtmlAttributes = and [] get (): int = unbox () [] - [] +// [] member _.value with set (_: string) = () and [] get (): string = unbox () @@ -2010,25 +2069,25 @@ module HtmlAttributes = and [] get (): bool = unbox () [] - [] +// [] member _.charset with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.crossorigin with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.defer with set (_: bool) = () and [] get (): bool = unbox () [] - [] +// [] member _.integrity with set (_: string) = () and [] get (): string = unbox () @@ -2039,31 +2098,31 @@ module HtmlAttributes = and [] get (): bool = unbox () [] - [] +// [] member _.nonce with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.referrerpolicy with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.src with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.type' with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.crossOrigin with set (_: string) = () and [] get (): string = unbox () @@ -2074,7 +2133,7 @@ module HtmlAttributes = and [] get (): bool = unbox () [] - [] +// [] member _.referrerPolicy with set (_: string) = () and [] get (): string = unbox () @@ -2082,7 +2141,7 @@ module HtmlAttributes = type SelectHTMLAttributes with [] - [] +// [] member _.autocomplete with set (_: string) = () and [] get (): string = unbox () @@ -2098,7 +2157,7 @@ module HtmlAttributes = and [] get (): bool = unbox () [] - [] +// [] member _.form with set (_: string) = () and [] get (): string = unbox () @@ -2109,7 +2168,7 @@ module HtmlAttributes = and [] get (): bool = unbox () [] - [] +// [] member _.name with set (_: string) = () and [] get (): string = unbox () @@ -2125,7 +2184,7 @@ module HtmlAttributes = and [] get (): int = unbox () [] - [] +// [] member _.value with set (_: string) = () and [] get (): string = unbox () @@ -2133,7 +2192,7 @@ module HtmlAttributes = type HTMLSlotElementAttributes with [] - [] +// [] member _.name with set (_: string) = () and [] get (): string = unbox () @@ -2141,31 +2200,31 @@ module HtmlAttributes = type SourceHTMLAttributes with [] - [] +// [] member _.media with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.sizes with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.src with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.srcset with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.type' with set (_: string) = () and [] get (): string = unbox () @@ -2183,25 +2242,25 @@ module HtmlAttributes = type StyleHTMLAttributes with [] - [] +// [] member _.media with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.nonce with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.scoped with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.type' with set (_: string) = () and [] get (): string = unbox () @@ -2214,7 +2273,7 @@ module HtmlAttributes = and [] get (): int = unbox () [] - [] +// [] member _.headers with set (_: string) = () and [] get (): string = unbox () @@ -2237,7 +2296,7 @@ module HtmlAttributes = type TemplateHTMLAttributes with [] - [] +// [] member _.content with set (_: string) = () and [] get (): string = unbox () @@ -2245,7 +2304,7 @@ module HtmlAttributes = type TextareaHTMLAttributes with [] - [] +// [] member _.autocomplete with set (_: string) = () and [] get (): string = unbox () @@ -2261,7 +2320,7 @@ module HtmlAttributes = and [] get (): int = unbox () [] - [] +// [] member _.dirname with set (_: string) = () and [] get (): string = unbox () @@ -2272,13 +2331,13 @@ module HtmlAttributes = and [] get (): bool = unbox () [] - [] +// [] member _.enterkeyhint with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.form with set (_: string) = () and [] get (): string = unbox () @@ -2294,13 +2353,13 @@ module HtmlAttributes = and [] get (): int = unbox () [] - [] +// [] member _.name with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.placeholder with set (_: string) = () and [] get (): string = unbox () @@ -2321,13 +2380,13 @@ module HtmlAttributes = and [] get (): int = unbox () [] - [] +// [] member _.value with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.wrap with set (_: string) = () and [] get (): string = unbox () @@ -2355,7 +2414,7 @@ module HtmlAttributes = and [] get (): int = unbox () [] - [] +// [] member _.headers with set (_: string) = () and [] get (): string = unbox () @@ -2376,7 +2435,7 @@ module HtmlAttributes = and [] get (): int = unbox () [] - [] +// [] member _.scope with set (_: string) = () and [] get (): string = unbox () @@ -2384,13 +2443,13 @@ module HtmlAttributes = type TimeHTMLAttributes with [] - [] +// [] member _.datetime with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.dateTime with set (_: string) = () and [] get (): string = unbox () @@ -2398,31 +2457,31 @@ module HtmlAttributes = type TrackHTMLAttributes with [] - [] +// [] member _.default' with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.kind with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.label with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.src with set (_: string) = () and [] get (): string = unbox () [] - [] +// [] member _.srclang with set (_: string) = () and [] get (): string = unbox () @@ -2440,7 +2499,7 @@ module HtmlAttributes = and [] get (): bool = unbox () [] - [] +// [] member _.poster with set (_: string) = () and [] get (): string = unbox () From e0dc7f1620d5f1bc7b76149475cf1dcbbd2ee326 Mon Sep 17 00:00:00 2001 From: cabboose Date: Mon, 8 Sep 2025 17:57:49 +0800 Subject: [PATCH 07/13] bump version --- Partas.Solid.FablePlugin/Partas.Solid.FablePlugin.fsproj | 4 ++-- Partas.Solid/Partas.Solid.fsproj | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/Partas.Solid.FablePlugin/Partas.Solid.FablePlugin.fsproj b/Partas.Solid.FablePlugin/Partas.Solid.FablePlugin.fsproj index a9565bd..6bfb317 100644 --- a/Partas.Solid.FablePlugin/Partas.Solid.FablePlugin.fsproj +++ b/Partas.Solid.FablePlugin/Partas.Solid.FablePlugin.fsproj @@ -13,8 +13,8 @@ MIT Shayan Habibi based on work by Vladimir Schur and contributors Copyright (c) Shayan Habibi 2025 - 2.1.0-alpha.4 - 2.1.0-alpha.4 + 2.1.0-alpha.5 + 2.1.0-alpha.5 diff --git a/Partas.Solid/Partas.Solid.fsproj b/Partas.Solid/Partas.Solid.fsproj index 2c1d628..9adae50 100644 --- a/Partas.Solid/Partas.Solid.fsproj +++ b/Partas.Solid/Partas.Solid.fsproj @@ -16,8 +16,8 @@ Shayan Habibi, Vladimir Schur and Contributors Copyright (c) Shayan Habibi 2025, based on work by Vladimir Schur 2024 README.md - 2.1.0-alpha.4 - 2.1.0-alpha.4 + 2.1.0-alpha.5 + 2.1.0-alpha.5 From c98102f9ca2d757a0fe7b84c4123e12ba5cafe9a Mon Sep 17 00:00:00 2001 From: cabboose <57953499+shayanhabibi@users.noreply.github.com> Date: Mon, 8 Sep 2025 23:35:36 +0800 Subject: [PATCH 08/13] fix(plugin): recursive optimisation of pattern matches in attributes/properties (#41) Also fixed the spawning of `singleton` operations in pattern matches. Previously, reactivity of solid-js would be broken when pattern matching on a property directly. This is because the generation of the expression `(matchValue = props.___, matchValue === ____ ? ____ : ___)` et al would not be caught by the solid-js library/compiler. For this reason, we remove this CE optimisation when pattern matching on property getters only. This behaviour can be disabled using the SkipCEOptimisation component flag. This constitutes a 'fix' more than a breaking change. --- Partas.Solid.FablePlugin/Plugin.fs | 103 +++++++++++++++++- Partas.Solid.FablePlugin/Utils.fs | 18 ++- .../Partas.Solid.Tests.Plugin.Compiled.fsproj | 2 + .../OperatorsInProps.expected | 5 +- .../ValueUnrollerDecisionTree.expected | 19 ++++ .../ValueUnrollerDecisionTree.fs | 78 +++++++++++++ Partas.Solid.Tests.Plugin/Tests.fs | 4 +- 7 files changed, 220 insertions(+), 9 deletions(-) create mode 100644 Partas.Solid.Tests.Plugin/Compiled/SolidCases/ValueUnrollerDecisionTree/ValueUnrollerDecisionTree.expected create mode 100644 Partas.Solid.Tests.Plugin/Compiled/SolidCases/ValueUnrollerDecisionTree/ValueUnrollerDecisionTree.fs diff --git a/Partas.Solid.FablePlugin/Plugin.fs b/Partas.Solid.FablePlugin/Plugin.fs index 4791bea..0a3c36b 100644 --- a/Partas.Solid.FablePlugin/Plugin.fs +++ b/Partas.Solid.FablePlugin/Plugin.fs @@ -25,6 +25,76 @@ module internal rec AST = module Utils = Patterns [] module AttributesAndProperties = + let private (|MatchValueReplacerFeedback|) (ctx: PluginContext) (ident: Expr): Expr -> Expr list = function + | expr -> + if ctx.Flags.HasFlag(ComponentFlag.SkipCEOptimisation) + then [ expr ] + else + match [ expr ] with + | MatchValueReplacer ctx ident exprs -> exprs + + /// This is essentially a copy pasta of the ValueUnroller. For the sake of preventing double + /// node traversal we're mashing that into this until we can start measuring costs in performance. + let private (|MatchValueReplacer|) (ctx: PluginContext) (ident: Expr): Expr list -> Expr list = function + | [] -> [] + | Sequential (MatchValueReplacer ctx ident exprs) :: rest -> + exprs @ rest + | expr :: MatchValueReplacer ctx ident rest -> + match expr with + | IdentExpr({ Name = Utils.StartsWith "matchValue" }) -> + ident :: rest + | Call(Import({ Selector = (Utils.StartsWith "toArray" | Utils.StartsWith "toList") }, Any, None), { Args = MatchValueReplacer ctx ident exprs }, typ, range) -> + Value(NewArray(ArrayValues exprs, Any, ArrayKind.MutableArray), range) :: rest + | Call(Import({ Selector = Utils.StartsWith "delay" }, Any, None), { Args = MatchValueReplacer ctx ident exprs }, typ, range) -> + exprs @ rest + | Lambda({ Name = Utils.StartsWith "unitVar"; IsCompilerGenerated = true }, MatchValueReplacerFeedback ctx ident exprs, range) -> + exprs @ rest + | Call(Import({ Selector = Utils.StartsWith "append" }, Any, None), { Args = MatchValueReplacer ctx ident exprs }, typ, range) -> + exprs @ rest + | Call(Import({Selector = Utils.StartsWith "singleton"}, Any, None), { Args = value :: MatchValueReplacer ctx ident exprs }, typ, range) -> + exprs @ (value :: rest) + | Call(Import({ Selector = Utils.StartsWith "empty"; Path = Utils.EndsWith "Seq.js" }, Any, None), { Args = []; GenericArgs = typ :: _ }, _, _) -> + Value(ValueKind.Null(typ), None) :: rest + | Call(callee, ({ Args = MatchValueReplacer ctx ident exprs } as callInfo), typ, range) -> + Call(callee, { callInfo with Args = exprs }, typ, range) :: rest + // If we hit this path, then we are likely matching on a new identifier + | Let({ Name = Utils.StartsWith "matchValue" } as identifier, body, value) -> + match body with + // If it is a property, we will preform the replacer with the new identifier + | PropertyGetter ctx prop -> + let newIdent = propGetter prop + match value with + // reduction with new identifier + | MatchValueReplacerFeedback ctx newIdent newValue -> + newValue @ rest + | MatchValueReplacerFeedback ctx ident bodyExprs -> + match value with MatchValueReplacerFeedback ctx ident valueExprs -> + Let(identifier, AstUtils.Sequential bodyExprs, AstUtils.Sequential valueExprs) :: rest + + | Let({ Name = Utils.StartsWith "matchValue" } as ident, MatchValueReplacerFeedback ctx ident body, MatchValueReplacerFeedback ctx ident value) -> + Let(ident, AstUtils.Sequential body, AstUtils.Sequential value) :: rest + | TypeCast(MatchValueReplacerFeedback ctx ident exprs, typ) -> + exprs @ rest + | IfThenElse(MatchValueReplacerFeedback ctx ident guardExprs, MatchValueReplacerFeedback ctx ident thenExprs, MatchValueReplacerFeedback ctx ident elseExprs, range) -> + IfThenElse(AstUtils.Sequential guardExprs, AstUtils.Sequential thenExprs, AstUtils.Sequential elseExprs, range) :: rest + | DecisionTree(MatchValueReplacerFeedback ctx ident expr, targets) -> + let targets = + targets + |> List.map(fun (idents,expr) -> + idents, + match expr with + | MatchValueReplacerFeedback ctx ident result -> + AstUtils.Sequential result + ) + DecisionTree(AstUtils.Sequential expr, targets) :: rest + | Operation (Binary (binaryOperator, MatchValueReplacerFeedback ctx ident left, MatchValueReplacerFeedback ctx ident right), tags, ``type``, sourceLocationOption) -> + Operation(Binary(binaryOperator, AstUtils.Sequential left, AstUtils.Sequential right), tags, ``type``, sourceLocationOption) :: rest + | Operation (OperationKind.Logical (binaryOperator, MatchValueReplacerFeedback ctx ident left, MatchValueReplacerFeedback ctx ident right), tags, ``type``, sourceLocationOption) -> + Operation(Logical(binaryOperator, AstUtils.Sequential left, AstUtils.Sequential right), tags, ``type``, sourceLocationOption) :: rest + | Operation (OperationKind.Unary (binaryOperator, MatchValueReplacerFeedback ctx ident unaryExprs), tags, ``type``, sourceLocationOption) -> + Operation(Unary(binaryOperator, AstUtils.Sequential unaryExprs), tags, ``type``, sourceLocationOption) :: rest + | expr -> expr :: rest + let (|ValueUnrollerFeedback|) (ctx: PluginContext) (expr: Expr): Expr list = if ctx |> PluginContext.hasFlag ComponentFlag.SkipCEOptimisation then [ expr ] @@ -57,10 +127,39 @@ module internal rec AST = Value(ValueKind.Null(typ), None) :: rest | Call(callee, ({ Args = ValueUnroller ctx exprs } as callInfo), typ, range) -> Call(callee, { callInfo with Args = exprs }, typ, range) :: rest + | Let({ Name = Utils.StartsWith "matchValue" } as ident, body, value) -> + match body with + | PropertyGetter ctx prop -> + let newIdent = propGetter prop + match value with + | MatchValueReplacerFeedback ctx newIdent newValue -> + newValue @ rest + | ValueUnrollerFeedback ctx bodyExprs -> + match value with ValueUnrollerFeedback ctx valueExprs -> + Let(ident, AstUtils.Sequential bodyExprs, AstUtils.Sequential valueExprs) :: rest + + | Let({ Name = Utils.StartsWith "matchValue" } as ident, ValueUnrollerFeedback ctx body, ValueUnrollerFeedback ctx value) -> + Let(ident, AstUtils.Sequential body, AstUtils.Sequential value) :: rest | TypeCast(ValueUnrollerFeedback ctx exprs, typ) -> exprs @ rest | IfThenElse(ValueUnrollerFeedback ctx guardExprs, ValueUnrollerFeedback ctx thenExprs, ValueUnrollerFeedback ctx elseExprs, range) -> - IfThenElse(Sequential guardExprs, Sequential thenExprs, Sequential elseExprs, range) :: rest + IfThenElse(AstUtils.Sequential guardExprs, AstUtils.Sequential thenExprs, AstUtils.Sequential elseExprs, range) :: rest + | DecisionTree(ValueUnrollerFeedback ctx expr, targets) -> + let targets = + targets + |> List.map(fun (idents,expr) -> + idents, + match expr with + | ValueUnrollerFeedback ctx result -> + AstUtils.Sequential result + ) + DecisionTree(AstUtils.Sequential expr, targets) :: rest + | Operation (Binary (binaryOperator, ValueUnrollerFeedback ctx left, ValueUnrollerFeedback ctx right), tags, ``type``, sourceLocationOption) -> + Operation(Binary(binaryOperator, AstUtils.Sequential left, AstUtils.Sequential right), tags, ``type``, sourceLocationOption) :: rest + | Operation (OperationKind.Logical (binaryOperator, ValueUnrollerFeedback ctx left, ValueUnrollerFeedback ctx right), tags, ``type``, sourceLocationOption) -> + Operation(Logical(binaryOperator, AstUtils.Sequential left, AstUtils.Sequential right), tags, ``type``, sourceLocationOption) :: rest + | Operation (OperationKind.Unary (binaryOperator, ValueUnrollerFeedback ctx unaryExprs), tags, ``type``, sourceLocationOption) -> + Operation(Unary(binaryOperator, AstUtils.Sequential unaryExprs), tags, ``type``, sourceLocationOption) :: rest | expr -> expr :: rest @@ -109,7 +208,7 @@ module internal rec AST = /// comes BEFORE the PropertySetter recognizer. The Setter is greedy, and will /// nullify expressions that are attribute expressions which involve the props ident /// - let private (|PropertyGetter|_|) (ctx: PluginContext) = function + let private (|PropertyGetter|_|) (ctx: PluginContext): Expr -> string option = function | Get( expr = ( // Defined locally diff --git a/Partas.Solid.FablePlugin/Utils.fs b/Partas.Solid.FablePlugin/Utils.fs index 027163e..0b98be3 100644 --- a/Partas.Solid.FablePlugin/Utils.fs +++ b/Partas.Solid.FablePlugin/Utils.fs @@ -11,6 +11,12 @@ type AstUtilHelpers = open type AstUtilHelpers type AstUtils = + + /// Creates a unit constant expression + static member inline Unit = Expr.Value (ValueKind.UnitConstant, range) + /// Creates a null constant expression + static member inline Null = Expr.Value (ValueKind.Null any, range) + /// Creates a string constant expression static member inline Value(stringValue: string) = Expr.Value (ValueKind.StringConstant stringValue, range) @@ -36,6 +42,14 @@ type AstUtils = |> Array.toList |> Sequential + /// Will check if expr list is either empty, and emit a null; a single expr long, and emit that expr; else + /// wraps the expressions in a Sequential DU + static member inline Sequential(exprList: Expr list) : Expr = + match exprList with + | [] -> AstUtils.Unit + | [ expr ] -> expr + | _ -> Sequential exprList + /// Creates a user import expression with the selector and path static member inline Import(selector: string, path: string) = Expr.Import ( @@ -70,10 +84,6 @@ type AstUtils = let typ = defaultArg typ any Expr.Call (callee, info, typ, range) - /// Creates a unit constant expression - static member inline Unit = Expr.Value (ValueKind.UnitConstant, range) - /// Creates a null constant expression - static member inline Null = Expr.Value (ValueKind.Null any, range) /// Creates an anonymous record from the list of string (field) expr (value) tuples static member inline Object(pairs: (string * Expr) list) = diff --git a/Partas.Solid.Tests.Plugin/Compiled/Partas.Solid.Tests.Plugin.Compiled.fsproj b/Partas.Solid.Tests.Plugin/Compiled/Partas.Solid.Tests.Plugin.Compiled.fsproj index 7f0945c..6e9024a 100644 --- a/Partas.Solid.Tests.Plugin/Compiled/Partas.Solid.Tests.Plugin.Compiled.fsproj +++ b/Partas.Solid.Tests.Plugin/Compiled/Partas.Solid.Tests.Plugin.Compiled.fsproj @@ -93,6 +93,8 @@ + + diff --git a/Partas.Solid.Tests.Plugin/Compiled/SolidCases/OperatorsInProps/OperatorsInProps.expected b/Partas.Solid.Tests.Plugin/Compiled/SolidCases/OperatorsInProps/OperatorsInProps.expected index f4d47ef..55023da 100644 --- a/Partas.Solid.Tests.Plugin/Compiled/SolidCases/OperatorsInProps/OperatorsInProps.expected +++ b/Partas.Solid.Tests.Plugin/Compiled/SolidCases/OperatorsInProps/OperatorsInProps.expected @@ -1,3 +1,4 @@ + import { Match, Switch, splitProps, mergeProps, onCleanup, createEffect, createSignal, useContext, createContext } from "solid-js"; import { twMerge } from "tailwind-merge"; import { clsx } from "clsx"; @@ -76,8 +77,8 @@ export function Sidebar(props) { -
-
+
diff --git a/Partas.Solid.Tests.Plugin/Compiled/SolidCases/ValueUnrollerDecisionTree/ValueUnrollerDecisionTree.expected b/Partas.Solid.Tests.Plugin/Compiled/SolidCases/ValueUnrollerDecisionTree/ValueUnrollerDecisionTree.expected new file mode 100644 index 0000000..5dcd362 --- /dev/null +++ b/Partas.Solid.Tests.Plugin/Compiled/SolidCases/ValueUnrollerDecisionTree/ValueUnrollerDecisionTree.expected @@ -0,0 +1,19 @@ + +import { twMerge } from "tailwind-merge"; +import { clsx } from "clsx"; +import { splitProps } from "solid-js"; + +export function Lib_cn_Z35CD86D0(classes) { + return twMerge(clsx(classes)); +} + +export function ValueUnrollTest(props) { + const [PARTAS_LOCAL, PARTAS_OTHERS] = splitProps(props, []); + return
; +} + +export function ValueUnrollNestedTest(props) { + const [PARTAS_LOCAL, PARTAS_OTHERS] = splitProps(props, []); + return
; +} + diff --git a/Partas.Solid.Tests.Plugin/Compiled/SolidCases/ValueUnrollerDecisionTree/ValueUnrollerDecisionTree.fs b/Partas.Solid.Tests.Plugin/Compiled/SolidCases/ValueUnrollerDecisionTree/ValueUnrollerDecisionTree.fs new file mode 100644 index 0000000..ca0ea01 --- /dev/null +++ b/Partas.Solid.Tests.Plugin/Compiled/SolidCases/ValueUnrollerDecisionTree/ValueUnrollerDecisionTree.fs @@ -0,0 +1,78 @@ +module Partas.Solid.Tests.Plugin.Compiled.SolidCases.ValueUnrollerDecisionTree.ValueUnrollerDecisionTree + +open Partas.Solid +open Fable.Core +open Fable.Core.JS +open Fable.Core.JsInterop + +[] +type Lib = + [] + static member twMerge(classes: string) : string = jsNative + + [] + static member clsx(classes: obj) : string = jsNative + + [] + static member cn(classes: string array) : string = + classes + |> Lib.clsx + |> Lib.twMerge + +[] +type Variant = + | Black + | Brown + | Green + +[] +type ValueUnrollTest() = + interface RegularNode + + [] + val mutable variant: Variant + + [] + member props.__ = + div ( + class' = + Lib.cn + [| "bg-primary" + match props.variant with + | Brown -> "brown" + | Black -> "black" + | Green -> "green" |] + ) + +[] +type AltVariant = + | Blue + | Orange + | Yellow + +[] +type ValueUnrollNestedTest() = + interface RegularNode + + [] + val mutable variant: Variant + + [] + val mutable altVariant: AltVariant + + [] + member props.__ = + div ( + class' = + Lib.cn + [| "bg-primary" + match props.variant with + | Brown -> "brown" + | Black when props.altVariant = Blue -> "black & blue" + | Black -> "black" + | Green -> + match props.altVariant with + | Blue -> "green & blue" + | Orange -> "orange & blue" + | Yellow -> "yellow & blue" |] + ) diff --git a/Partas.Solid.Tests.Plugin/Tests.fs b/Partas.Solid.Tests.Plugin/Tests.fs index 7ddf3db..0e28b82 100644 --- a/Partas.Solid.Tests.Plugin/Tests.fs +++ b/Partas.Solid.Tests.Plugin/Tests.fs @@ -94,7 +94,9 @@ let SolidCases = "ChildLambdaProvider" |> runSolidCase "ChildLambdaProvider interfaces" "SolidComponentAsTagValues" - |> runSolidCase "SolidComponent let bindings as TagValues" ] + |> runSolidCase "SolidComponent let bindings as TagValues" + "ValueUnrollerDecisionTree" + |> runSolidCase "Decision Trees in arrays do not spawn singleton instructions" ] [] let AttributeCases = From c8127f2c497fd65b2a407983d482ac32a910dff6 Mon Sep 17 00:00:00 2001 From: cabboose Date: Tue, 9 Sep 2025 00:13:35 +0800 Subject: [PATCH 09/13] fix(plugin): ArrayAlloc and ArrayFrom expressions are transformed --- .../Partas.Solid.FablePlugin.fsproj | 4 +- Partas.Solid.FablePlugin/Plugin.fs | 6 +- Partas.Solid/HtmlAttributes.fs | 386 +++++++++--------- Partas.Solid/Partas.Solid.fsproj | 4 +- 4 files changed, 202 insertions(+), 198 deletions(-) diff --git a/Partas.Solid.FablePlugin/Partas.Solid.FablePlugin.fsproj b/Partas.Solid.FablePlugin/Partas.Solid.FablePlugin.fsproj index 6bfb317..98cdbe9 100644 --- a/Partas.Solid.FablePlugin/Partas.Solid.FablePlugin.fsproj +++ b/Partas.Solid.FablePlugin/Partas.Solid.FablePlugin.fsproj @@ -13,8 +13,8 @@ MIT Shayan Habibi based on work by Vladimir Schur and contributors Copyright (c) Shayan Habibi 2025 - 2.1.0-alpha.5 - 2.1.0-alpha.5 + 2.1.0-alpha.6 + 2.1.0-alpha.6 diff --git a/Partas.Solid.FablePlugin/Plugin.fs b/Partas.Solid.FablePlugin/Plugin.fs index 0a3c36b..9f1cd1d 100644 --- a/Partas.Solid.FablePlugin/Plugin.fs +++ b/Partas.Solid.FablePlugin/Plugin.fs @@ -854,7 +854,7 @@ module internal rec AST = | Value( ( NewAnonymousRecord(_) - | NewArray(newKind = ArrayValues _) + | NewArray _ | NewList(headAndTail = Some _) | NewRecord(_) | StringTemplate(_) @@ -877,6 +877,10 @@ module internal rec AST = NewOption(Some (transform ctx expr), typ, isStruct) | NewArray(ArrayValues values, typ, kind) -> NewArray(ArrayValues (transformValues values), typ, kind) + | NewArray(ArrayAlloc expr, typ, kind) -> + NewArray(ArrayAlloc (transform ctx expr), typ, kind) + | NewArray(ArrayFrom expr, typ, kind) -> + NewArray(ArrayFrom (transform ctx expr), typ, kind) | NewList(Some(expr1, expr2), typ) -> NewList(Some(transform ctx expr1, transform ctx expr2), typ) | NewRecord(values, ref, genArgs) -> diff --git a/Partas.Solid/HtmlAttributes.fs b/Partas.Solid/HtmlAttributes.fs index 280c3a3..35e95c8 100644 --- a/Partas.Solid/HtmlAttributes.fs +++ b/Partas.Solid/HtmlAttributes.fs @@ -12,8 +12,8 @@ module HtmlAttributes = type HtmlContainer with [] member _.children - with set(value: HtmlElement) = JS.undefined - and get(): HtmlElement = JS.undefined + with set (value: HtmlElement) = JS.undefined + and get (): HtmlElement = JS.undefined type HTMLAttributes with [] @@ -829,67 +829,67 @@ module HtmlAttributes = type AreaHTMLAttributes with [] -// [] + // [] member _.alt with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.coords with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.download with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.href with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.hreflang with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.ping with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.referrerpolicy with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.rel with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.shape with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.target with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.referrerPolicy with set (_: string) = () and [] get (): string = unbox () @@ -897,13 +897,13 @@ module HtmlAttributes = type BaseHTMLAttributes with [] -// [] + // [] member _.href with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.target with set (_: string) = () and [] get (): string = unbox () @@ -911,7 +911,7 @@ module HtmlAttributes = type BlockquoteHTMLAttributes with [] -// [] + // [] member _.cite with set (_: string) = () and [] get (): string = unbox () @@ -929,7 +929,7 @@ module HtmlAttributes = and [] get (): bool = unbox () [] -// [] + // [] member _.form with set (_: string) = () and [] get (): string = unbox () @@ -940,55 +940,55 @@ module HtmlAttributes = and [] get (): bool = unbox () [] -// [] + // [] member _.name with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.type' with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.value with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.formAction with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.formEnctype with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.formMethod with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.formTarget with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.popoverTarget with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.popoverTargetAction with set (_: string) = () and [] get (): string = unbox () @@ -1027,7 +1027,7 @@ module HtmlAttributes = type DataHTMLAttributes with [] -// [] + // [] member _.value with set (_: string) = () and [] get (): string = unbox () @@ -1069,13 +1069,13 @@ module HtmlAttributes = and [] get (): int = unbox () [] -// [] + // [] member _.src with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.type' with set (_: string) = () and [] get (): string = unbox () @@ -1093,13 +1093,13 @@ module HtmlAttributes = and [] get (): bool = unbox () [] -// [] + // [] member _.form with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.name with set (_: string) = () and [] get (): string = unbox () @@ -1107,55 +1107,55 @@ module HtmlAttributes = type FormHTMLAttributes with [] -// [] + // [] member _.accept with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.action with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.autocomplete with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.encoding with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.enctype with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.method with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.name with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.noValidate with set (_: bool) = () and [] get (): bool = unbox () [] -// [] + // [] member _.target with set (_: string) = () and [] get (): string = unbox () @@ -1164,13 +1164,13 @@ module HtmlAttributes = type IframeHTMLAttributes with [] -// [] + // [] member _.allow with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.allowfullscreen with set (_: string) = () and [] get (): string = unbox () @@ -1181,37 +1181,37 @@ module HtmlAttributes = and [] get (): int = unbox () [] -// [] + // [] member _.loading with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.name with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.referrerpolicy with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.sandbox with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.src with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.srcdoc with set (_: string) = () and [] get (): string = unbox () @@ -1222,7 +1222,7 @@ module HtmlAttributes = and [] get (): int = unbox () [] -// [] + // [] member _.referrerPolicy with set (_: string) = () and [] get (): string = unbox () @@ -1230,19 +1230,19 @@ module HtmlAttributes = type ImgHTMLAttributes with [] -// [] + // [] member _.alt with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.crossorigin with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.decoding with set (_: string) = () and [] get (): string = unbox () @@ -1258,55 +1258,55 @@ module HtmlAttributes = and [] get (): bool = unbox () [] -// [] + // [] member _.loading with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.referrerpolicy with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.referrerPolicy with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.sizes with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.src with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.srcset with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.srcSet with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.usemap with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.useMap with set (_: string) = () and [] get (): string = unbox () @@ -1317,19 +1317,19 @@ module HtmlAttributes = and [] get (): int = unbox () [] -// [] + // [] member _.crossOrigin with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.elementtiming with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.fetchpriority with set (_: string) = () and [] get (): string = unbox () @@ -1337,25 +1337,25 @@ module HtmlAttributes = type InputHTMLAttributes with [] -// [] + // [] member _.accept with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.alt with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.autocomplete with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.autocorrect with set (_: string) = () and [] get (): string = unbox () @@ -1366,7 +1366,7 @@ module HtmlAttributes = and [] get (): bool = unbox () [] -// [] + // [] member _.capture with set (_: string) = () and [] get (): string = unbox () @@ -1377,25 +1377,25 @@ module HtmlAttributes = and [] get (): bool = unbox () [] -// [] + // [] member _.crossorigin with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.disabled with set (_: bool) = () and [] get (): bool = unbox () [] -// [] + // [] member _.enterkeyhint with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.form with set (_: string) = () and [] get (): string = unbox () @@ -1406,7 +1406,7 @@ module HtmlAttributes = and [] get (): bool = unbox () [] -// [] + // [] member _.formtarget with set (_: string) = () and [] get (): string = unbox () @@ -1417,13 +1417,13 @@ module HtmlAttributes = and [] get (): int = unbox () [] -// [] + // [] member _.incremental with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.list with set (_: string) = () and [] get (): string = unbox () @@ -1454,19 +1454,19 @@ module HtmlAttributes = and [] get (): bool = unbox () [] -// [] + // [] member _.name with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.pattern with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.placeholder with set (_: string) = () and [] get (): string = unbox () @@ -1477,7 +1477,7 @@ module HtmlAttributes = and [] get (): bool = unbox () [] -// [] + // [] member _.results with set (_: string) = () and [] get (): string = unbox () @@ -1493,25 +1493,25 @@ module HtmlAttributes = and [] get (): int = unbox () [] -// [] + // [] member _.src with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.step with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.type' with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.value with set (_: string) = () and [] get (): string = unbox () @@ -1522,25 +1522,25 @@ module HtmlAttributes = and [] get (): int = unbox () [] -// [] + // [] member _.crossOrigin with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.formAction with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.formEnctype with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.formMethod with set (_: string) = () and [] get (): string = unbox () @@ -1551,7 +1551,7 @@ module HtmlAttributes = and [] get (): bool = unbox () [] -// [] + // [] member _.formTarget with set (_: string) = () and [] get (): string = unbox () @@ -1574,13 +1574,13 @@ module HtmlAttributes = type InsHTMLAttributes with [] -// [] + // [] member _.cite with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.dateTime with set (_: string) = () and [] get (): string = unbox () @@ -1593,7 +1593,7 @@ module HtmlAttributes = and [] get (): bool = unbox () [] -// [] + // [] member _.challenge with set (_: string) = () and [] get (): string = unbox () @@ -1604,25 +1604,25 @@ module HtmlAttributes = and [] get (): bool = unbox () [] -// [] + // [] member _.form with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.keytype with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.keyparams with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.name with set (_: string) = () and [] get (): string = unbox () @@ -1630,13 +1630,13 @@ module HtmlAttributes = type LabelHTMLAttributes with [] -// [] + // [] member _.for' with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.form with set (_: string) = () and [] get (): string = unbox () @@ -1644,7 +1644,7 @@ module HtmlAttributes = type LiHTMLAttributes with [] -// [] + // [] member _.value with set (_: string) = () and [] get (): string = unbox () @@ -1652,13 +1652,13 @@ module HtmlAttributes = type LinkHTMLAttributes with [] -// [] + // [] member _.as' with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.crossorigin with set (_: string) = () and [] get (): string = unbox () @@ -1669,79 +1669,79 @@ module HtmlAttributes = and [] get (): bool = unbox () [] -// [] + // [] member _.fetchpriority with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.href with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.hreflang with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.imagesizes with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.imagesrcset with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.integrity with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.media with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.referrerpolicy with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.rel with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.sizes with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.type' with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.crossOrigin with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.referrerPolicy with set (_: string) = () and [] get (): string = unbox () @@ -1749,7 +1749,7 @@ module HtmlAttributes = type MapHTMLAttributes with [] -// [] + // [] member _.name with set (_: string) = () and [] get (): string = unbox () @@ -1767,13 +1767,13 @@ module HtmlAttributes = and [] get (): bool = unbox () [] -// [] + // [] member _.controlslist with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.crossorigin with set (_: string) = () and [] get (): string = unbox () @@ -1784,7 +1784,7 @@ module HtmlAttributes = and [] get (): bool = unbox () [] -// [] + // [] member _.mediagroup with set (_: string) = () and [] get (): string = unbox () @@ -1795,25 +1795,25 @@ module HtmlAttributes = and [] get (): bool = unbox () [] -// [] + // [] member _.preload with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.src with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.crossOrigin with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.mediaGroup with set (_: string) = () and [] get (): string = unbox () @@ -1821,44 +1821,44 @@ module HtmlAttributes = type MenuHTMLAttributes with [] -// [] + // [] member _.label with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.type' with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.charset with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.content with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.http with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.name with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.media with set (_: string) = () and [] get (): string = unbox () @@ -1866,7 +1866,7 @@ module HtmlAttributes = type MeterHTMLAttributes with [] -// [] + // [] member _.form with set (_: string) = () and [] get (): string = unbox () @@ -1904,7 +1904,7 @@ module HtmlAttributes = type QuoteHTMLAttributes with [] -// [] + // [] member _.cite with set (_: string) = () and [] get (): string = unbox () @@ -1912,13 +1912,13 @@ module HtmlAttributes = type ObjectHTMLAttributes with [] -// [] + // [] member _.data with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.form with set (_: string) = () and [] get (): string = unbox () @@ -1929,19 +1929,19 @@ module HtmlAttributes = and [] get (): int = unbox () [] -// [] + // [] member _.name with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.type' with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.usemap with set (_: string) = () and [] get (): string = unbox () @@ -1952,7 +1952,7 @@ module HtmlAttributes = and [] get (): int = unbox () [] -// [] + // [] member _.useMap with set (_: string) = () and [] get (): string = unbox () @@ -1960,19 +1960,19 @@ module HtmlAttributes = type OlHTMLAttributes with [] -// [] + // [] member _.reversed with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.start with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.type' with set (_: string) = () and [] get (): string = unbox () @@ -1985,7 +1985,7 @@ module HtmlAttributes = and [] get (): bool = unbox () [] -// [] + // [] member _.label with set (_: string) = () and [] get (): string = unbox () @@ -1998,7 +1998,7 @@ module HtmlAttributes = and [] get (): bool = unbox () [] -// [] + // [] member _.label with set (_: string) = () and [] get (): string = unbox () @@ -2009,7 +2009,7 @@ module HtmlAttributes = and [] get (): bool = unbox () [] -// [] + // [] member _.value with set (_: string) = () and [] get (): string = unbox () @@ -2017,19 +2017,19 @@ module HtmlAttributes = type OutputHTMLAttributes with [] -// [] + // [] member _.form with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.for' with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.name with set (_: string) = () and [] get (): string = unbox () @@ -2037,13 +2037,13 @@ module HtmlAttributes = type ParamHTMLAttributes with [] -// [] + // [] member _.name with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.value with set (_: string) = () and [] get (): string = unbox () @@ -2056,7 +2056,7 @@ module HtmlAttributes = and [] get (): int = unbox () [] -// [] + // [] member _.value with set (_: string) = () and [] get (): string = unbox () @@ -2069,25 +2069,25 @@ module HtmlAttributes = and [] get (): bool = unbox () [] -// [] + // [] member _.charset with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.crossorigin with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.defer with set (_: bool) = () and [] get (): bool = unbox () [] -// [] + // [] member _.integrity with set (_: string) = () and [] get (): string = unbox () @@ -2098,31 +2098,31 @@ module HtmlAttributes = and [] get (): bool = unbox () [] -// [] + // [] member _.nonce with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.referrerpolicy with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.src with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.type' with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.crossOrigin with set (_: string) = () and [] get (): string = unbox () @@ -2133,7 +2133,7 @@ module HtmlAttributes = and [] get (): bool = unbox () [] -// [] + // [] member _.referrerPolicy with set (_: string) = () and [] get (): string = unbox () @@ -2141,7 +2141,7 @@ module HtmlAttributes = type SelectHTMLAttributes with [] -// [] + // [] member _.autocomplete with set (_: string) = () and [] get (): string = unbox () @@ -2157,7 +2157,7 @@ module HtmlAttributes = and [] get (): bool = unbox () [] -// [] + // [] member _.form with set (_: string) = () and [] get (): string = unbox () @@ -2168,7 +2168,7 @@ module HtmlAttributes = and [] get (): bool = unbox () [] -// [] + // [] member _.name with set (_: string) = () and [] get (): string = unbox () @@ -2184,7 +2184,7 @@ module HtmlAttributes = and [] get (): int = unbox () [] -// [] + // [] member _.value with set (_: string) = () and [] get (): string = unbox () @@ -2192,7 +2192,7 @@ module HtmlAttributes = type HTMLSlotElementAttributes with [] -// [] + // [] member _.name with set (_: string) = () and [] get (): string = unbox () @@ -2200,31 +2200,31 @@ module HtmlAttributes = type SourceHTMLAttributes with [] -// [] + // [] member _.media with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.sizes with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.src with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.srcset with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.type' with set (_: string) = () and [] get (): string = unbox () @@ -2242,25 +2242,25 @@ module HtmlAttributes = type StyleHTMLAttributes with [] -// [] + // [] member _.media with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.nonce with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.scoped with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.type' with set (_: string) = () and [] get (): string = unbox () @@ -2273,7 +2273,7 @@ module HtmlAttributes = and [] get (): int = unbox () [] -// [] + // [] member _.headers with set (_: string) = () and [] get (): string = unbox () @@ -2296,7 +2296,7 @@ module HtmlAttributes = type TemplateHTMLAttributes with [] -// [] + // [] member _.content with set (_: string) = () and [] get (): string = unbox () @@ -2304,7 +2304,7 @@ module HtmlAttributes = type TextareaHTMLAttributes with [] -// [] + // [] member _.autocomplete with set (_: string) = () and [] get (): string = unbox () @@ -2320,7 +2320,7 @@ module HtmlAttributes = and [] get (): int = unbox () [] -// [] + // [] member _.dirname with set (_: string) = () and [] get (): string = unbox () @@ -2331,13 +2331,13 @@ module HtmlAttributes = and [] get (): bool = unbox () [] -// [] + // [] member _.enterkeyhint with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.form with set (_: string) = () and [] get (): string = unbox () @@ -2353,13 +2353,13 @@ module HtmlAttributes = and [] get (): int = unbox () [] -// [] + // [] member _.name with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.placeholder with set (_: string) = () and [] get (): string = unbox () @@ -2380,13 +2380,13 @@ module HtmlAttributes = and [] get (): int = unbox () [] -// [] + // [] member _.value with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.wrap with set (_: string) = () and [] get (): string = unbox () @@ -2414,7 +2414,7 @@ module HtmlAttributes = and [] get (): int = unbox () [] -// [] + // [] member _.headers with set (_: string) = () and [] get (): string = unbox () @@ -2435,7 +2435,7 @@ module HtmlAttributes = and [] get (): int = unbox () [] -// [] + // [] member _.scope with set (_: string) = () and [] get (): string = unbox () @@ -2443,13 +2443,13 @@ module HtmlAttributes = type TimeHTMLAttributes with [] -// [] + // [] member _.datetime with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.dateTime with set (_: string) = () and [] get (): string = unbox () @@ -2457,31 +2457,31 @@ module HtmlAttributes = type TrackHTMLAttributes with [] -// [] + // [] member _.default' with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.kind with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.label with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.src with set (_: string) = () and [] get (): string = unbox () [] -// [] + // [] member _.srclang with set (_: string) = () and [] get (): string = unbox () @@ -2499,7 +2499,7 @@ module HtmlAttributes = and [] get (): bool = unbox () [] -// [] + // [] member _.poster with set (_: string) = () and [] get (): string = unbox () diff --git a/Partas.Solid/Partas.Solid.fsproj b/Partas.Solid/Partas.Solid.fsproj index 9adae50..89f7eaf 100644 --- a/Partas.Solid/Partas.Solid.fsproj +++ b/Partas.Solid/Partas.Solid.fsproj @@ -16,8 +16,8 @@ Shayan Habibi, Vladimir Schur and Contributors Copyright (c) Shayan Habibi 2025, based on work by Vladimir Schur 2024 README.md - 2.1.0-alpha.5 - 2.1.0-alpha.5 + 2.1.0-alpha.6 + 2.1.0-alpha.6 From 37b4f3050735d0c808bd07de7592874f736db9a1 Mon Sep 17 00:00:00 2001 From: cabboose Date: Tue, 9 Sep 2025 15:21:14 +0800 Subject: [PATCH 10/13] better expression collection abstraction --- .../Partas.Solid.FablePlugin.fsproj | 4 +- Partas.Solid.FablePlugin/Storybook.fs | 256 ++++++++---------- Partas.Solid.FablePlugin/Utils.fs | 84 ++++++ Partas.Solid/Partas.Solid.fsproj | 4 +- 4 files changed, 203 insertions(+), 145 deletions(-) diff --git a/Partas.Solid.FablePlugin/Partas.Solid.FablePlugin.fsproj b/Partas.Solid.FablePlugin/Partas.Solid.FablePlugin.fsproj index 98cdbe9..ef14eae 100644 --- a/Partas.Solid.FablePlugin/Partas.Solid.FablePlugin.fsproj +++ b/Partas.Solid.FablePlugin/Partas.Solid.FablePlugin.fsproj @@ -13,8 +13,8 @@ MIT Shayan Habibi based on work by Vladimir Schur and contributors Copyright (c) Shayan Habibi 2025 - 2.1.0-alpha.6 - 2.1.0-alpha.6 + 2.1.0-alpha.7 + 2.1.0-alpha.7 diff --git a/Partas.Solid.FablePlugin/Storybook.fs b/Partas.Solid.FablePlugin/Storybook.fs index 48656f3..6fa6014 100644 --- a/Partas.Solid.FablePlugin/Storybook.fs +++ b/Partas.Solid.FablePlugin/Storybook.fs @@ -290,19 +290,20 @@ module internal Utils = |> AstUtils.Object module internal rec StorybookTypeRecursion = - let (|EntityFullName|): DeclaredType -> string = _.Entity.FullName /// Filter interfaces that are predefined as thats too much noise. - let (|FeedInterface|) (ctx: PluginContext) : DeclaredType list -> DeclaredType list = + let (|FilterNativeTypes|) (ctx: PluginContext) : DeclaredType list -> DeclaredType list = function | [] -> [] - | declaredType :: FeedInterface ctx rest -> + | declaredType :: FilterNativeTypes ctx rest -> match declaredType with - | EntityFullName (StartsWith "Partas.Solid.Tags") -> rest + | typ when typ.Entity.FullName.StartsWith("Partas.Solid.Tags") -> rest | ent -> ent :: rest + /// Retrieve function members that are setters, and not inline, not internal, not private, and have + /// no more than 1 parameter. let private filterMembers (ctx: PluginContext) (decls: MemberFunctionOrValue seq) = decls |> Seq.filter (fun memb -> @@ -315,21 +316,25 @@ module internal rec StorybookTypeRecursion = |> not && memb.IsSetter) + /// Retrieve function members from a type and filter them let private getFilteredMembers (ctx: PluginContext) (decl: DeclaredType) = let entity = ctx.Helper.GetEntity decl.Entity entity.MembersFunctionsAndValues |> filterMembers ctx + /// Retrieve entity interfaces that are filtered let private getEntityInterfaces (ctx: PluginContext) (ent: Entity) = ent.AllInterfaces |> Seq.toList |> function - | FeedInterface ctx interfaces -> interfaces + | FilterNativeTypes ctx interfaces -> interfaces + /// Retrieve the entity from a declared type let private getEntity (ctx: PluginContext) (entityRef: DeclaredType) = ctx.Helper.GetEntity entityRef.Entity + /// Retrieve the filtered members and functions of an entity let rec private getEntityMembers (ctx: PluginContext) (entity: Entity) = let getMembers = entity.MembersFunctionsAndValues @@ -345,6 +350,7 @@ module internal rec StorybookTypeRecursion = |> Option.defaultValue [] |> List.append getMembers + /// Given an entity, collect the fields of it, and its declared interfaces or base types. let rec private collectEntityFields (ctx: PluginContext) (ent: Entity) = ent.BaseType |> Option.map ( @@ -358,11 +364,13 @@ module internal rec StorybookTypeRecursion = >> not ) + /// Retrieves the generic arg from one of our operations let (|GetGenericArg|) (ctx: PluginContext) = function | GetDeclaredType (Type.DeclaredType (ref, _)) -> ctx.Helper.GetEntity ref | _ -> failwith "Incorrect AST structure. Different to expected." + /// Collect the entity members and fields and process them let rec collectEntityMembers (ctx: PluginContext) (entity: Entity) = let baseAndEntityFields = collectEntityFields ctx entity @@ -387,143 +395,109 @@ module internal rec StorybookCases = { PropertyName: string Cases: string list } - let private makeCases (ctx: PluginContext) (typ: Type) (CasesExpr caseExpr) = - let fieldExtractor: Expr -> string option = - function - | Get ( - expr = IdentExpr { Type = identTyp } - kind = (GetKind.ExprGet (Value (kind = ValueKind.StringConstant (field))) | GetKind.FieldGet ({ Name = field }))) when identTyp = typ -> - Some field - | Call ( - callee = Import (typ = LambdaType (argType = typInfo); info = { Kind = MemberImport (MemberRef (_, { CompiledName = compiledName })) })) when - typ = typInfo - -> - compiledName.Split ('.') - |> Array.last - |> function - | StartsWithTrimmed "get_" value -> - value - |> StringUtils.TrimReservedIdentifiers - |> Some - | _ -> None - | _ -> None - - let rec (|GetCases|): Expr -> string list = - function - | Expr.Call (callee = GetCases values; info = { Args = GetCases headValues :: exprs }) -> - values - @ headValues - @ (exprs - |> List.collect (function - | GetCases values -> values)) - | Expr.CurriedApply (applied = GetCases values; args = exprs) -> - values - @ (exprs - |> List.collect (function - | GetCases values -> values)) - | Expr.DecisionTree (expr = GetCases values; targets = targets) -> - values - @ (targets - |> List.collect ( - snd - >> function - | GetCases values -> values - )) - | Expr.Delegate (body = GetCases values) -> values - | Expr.DecisionTreeSuccess (boundValues = exprs) -> - List.collect - (function - | GetCases values -> values) - exprs - | Expr.Get (expr = GetCases values; kind = kind) -> - match kind with - | ExprGet (GetCases values) -> values - | _ -> [] - @ values - | Expr.IfThenElse (guardExpr = GetCases values; elseExpr = GetCases elseValues; thenExpr = GetCases thenValues) -> - values - @ elseValues - @ thenValues - | Expr.Lambda (body = GetCases values) -> values - | Expr.Let (value = GetCases values; body = GetCases bodyValues) -> - values - @ bodyValues - | Expr.LetRec (bindings = exprs; body = GetCases values) -> - (exprs - |> List.collect ( - snd - >> function - | GetCases values -> values - )) - @ values - | Expr.ObjectExpr (baseCall = Some (GetCases values); members = members) -> - values - @ (members - |> List.collect ( - _.Body - >> function - | GetCases memberValues -> memberValues - )) - | Expr.ObjectExpr (members = members) -> - members - |> List.collect ( - _.Body - >> function - | GetCases values -> values - ) - | Expr.Operation ( - kind = OperationKind.Binary ( - operator = BinaryOperator.BinaryEqual; right = Value (kind = StringConstant value); left = GetCases values)) -> - value - :: values - | Expr.Operation (kind = OperationKind.Binary (operator = BinaryOperator.BinaryEqual; right = GetCases values; left = GetCases leftValues)) -> - leftValues - @ values - | Expr.Sequential (exprs = exprs) -> - exprs - |> List.collect (function - | GetCases values -> values) - | Expr.TypeCast (expr = GetCases values) -> values - | _ -> [] - - let field = - caseExpr - |> findAndDiscardElse ( - fieldExtractor - >> _.IsSome + type CasesInfo = { + MatchExpr: Expr + CaseContainer: Expr + } + // When collecting cases, we should first be able to assembler + // the type info and ident with a list of case expressions. + type CasesContext = { + Ident: Ident + Type: Type + CaseExprs: CasesInfo list + } + let private (|CaseProp|) (ctx: PluginContext): Expr -> string = function + | Get(kind = FieldGet({ Name = prop })) + | Call( info = { MemberRef = Some(MemberRef.MemberRefIs ctx MemberRefType.Getter) + & MemberRef.Option.PartasName ctx prop } ) -> + prop + | expr -> + $"While processing a case matchValue expression, we encountered an unknown getter expression: {expr}" + |> PluginContext.logWarning ctx + "ERROR" + let private (|CaseValues|) (ctx: PluginContext): Expr -> string list = function + | Value(StringConstant(prop), _) -> [ prop ] + | DecisionTree(CaseValues ctx values, targets) -> + let targets = + targets |> List.collect(snd >> function CaseValues ctx values -> values) + values @ targets + | IfThenElse(CaseValues ctx values,CaseValues ctx thens, CaseValues ctx elses,_) -> + values @ thens @ elses + | Operation(kind = Binary(left = CaseValues ctx left; right = CaseValues ctx right)) -> + left @ right + | _ -> [] + + let private (|CaseSubExpression|_|) (ctx: PluginContext) (cases: CasesContext): Expr -> CasesContext option = function + | Let({ Name = StartsWith "matchValue" }, body: Expr, value: Expr) -> + // the body is the actual expression/getter. + Some { + cases with + CaseExprs = { + MatchExpr = body + CaseContainer = value + } :: cases.CaseExprs + } + | _ -> None + + let private (|CollectMatchersFeedback|) (ctx: PluginContext): Expr -> Expr list = function + | expr -> + [ expr ] |> function CollectMatchers ctx values -> values + + let private (|CollectMatchers|) (ctx: PluginContext): Expr list -> Expr list = function + | [] -> [] + | Sequential(CollectMatchers ctx left) :: CollectMatchers ctx right -> + left @ right + | expr :: CollectMatchers ctx rest -> + match expr with + | Let({ Name = StartsWith "matchValue" }, body, value) -> + expr :: rest + | Call(info = { Args = CollectMatchers ctx values }) -> + values @ rest + | CurriedApply(CollectMatchersFeedback ctx values, CollectMatchers ctx otherValues, _, _) -> + values @ otherValues @ rest + | Lambda(body = CollectMatchersFeedback ctx values) + | Delegate(body = CollectMatchersFeedback ctx values) -> + values @ rest + | _ -> rest + + + let getCases (ctx: PluginContext) (entityTyp: Type) = + let predicate = function Lambda(name = Some(StartsWith "PARTAS_CASES")) -> true | _ -> false + function + | ExprMatchingFunFeedback predicate caseExprs -> + caseExprs + |> List.collect(function + | Lambda(arg = ident; body = expr) -> + let caseContext = { + Ident = ident + Type = entityTyp + CaseExprs = [] + } + let predicate = function + | CaseSubExpression ctx caseContext _ -> true + | _ -> false + match expr with + | ExprMatchingFunFeedback predicate caseSubExprs -> + let folder = fun caseContext expr -> + match expr with + | CaseSubExpression ctx caseContext value -> + value + | _ -> caseContext + + caseSubExprs + |> List.fold folder caseContext + | e -> failwith $"This expr should have been unreachable inside the ExprMatchingFunFeedback loop. Please report this and the reproducing code. Expr: {e}" + >> _.CaseExprs ) - |> List.choose fieldExtractor - - field - |> List.map (fun fieldName -> - { PropertyName = fieldName - Cases = - caseExpr - |> function - | GetCases values -> values }) - - let private findMatchers (ctx: PluginContext) (expr: Expr list) = - let matcher = - findAndDiscardElse (function - | Let ( - ident = { Name = StartsWith ("matchValue") - Type = Type.String }) -> true - | _ -> false) - - expr - |> List.collect matcher - |> List.map CasesExpr - - let getCases (ctx: PluginContext) (entityTyp: Type) (expr: Expr) = - findMatchers ctx [ expr ] - |> List.collect (makeCases ctx entityTyp) - |> List.groupBy _.PropertyName - |> List.map (fun (key, cases) -> - { PropertyName = key - Cases = - cases - |> List.collect _.Cases - |> List.distinct }) + |> List.map(fun caseInfo -> + let prop = + caseInfo.MatchExpr |> function CaseProp ctx prop -> prop + let matches = + caseInfo.CaseContainer |> function + | CaseValues ctx values -> values + { PropertyName = prop; Cases = matches |> List.distinct } + ) + module internal rec StorybookRender = let getRender (ctx: PluginContext) (expr: Expr) = diff --git a/Partas.Solid.FablePlugin/Utils.fs b/Partas.Solid.FablePlugin/Utils.fs index 0b98be3..39021a8 100644 --- a/Partas.Solid.FablePlugin/Utils.fs +++ b/Partas.Solid.FablePlugin/Utils.fs @@ -493,6 +493,90 @@ module Expr = |> filterList | _ -> [] + let rec (|ExprMatchingFunFeedback|) (func: Expr -> bool): Expr -> Expr list = function + | expr when func expr -> [ expr ] + | expr -> + match [ expr ] with + | ExprMatchingFun func result -> result + and (|ExprMatchingFun|) (func: Expr -> bool): Expr list -> Expr list = function + | [] -> [] + | expr :: ExprMatchingFun func rest when func expr -> + expr :: rest + | Sequential(ExprMatchingFun func values) :: ExprMatchingFun func rest -> + values @ rest + | expr :: ExprMatchingFun func rest -> + match expr with + | Value (kind, range) -> + match kind with + | StringTemplate (tag = tag; values = ExprMatchingFun func values) -> + match tag with + | Some(ExprMatchingFunFeedback func tagValues) -> + tagValues @ values @ rest + | _ -> values @ rest + | NewOption (value = Some(ExprMatchingFunFeedback func values)) -> values @ rest + | NewArray (newKind = newKind ) -> + match newKind with + | ArrayAlloc (ExprMatchingFunFeedback func values) + | ArrayFrom (ExprMatchingFunFeedback func values) + | ArrayValues (ExprMatchingFun func values) -> values @ rest + | NewList (Some(ExprMatchingFunFeedback func left, ExprMatchingFunFeedback func right), _) -> + left @ right @ rest + | NewTuple (values = ExprMatchingFun func values) + | NewRecord (values = ExprMatchingFun func values) + | NewAnonymousRecord (values = ExprMatchingFun func values) + | NewUnion (values = ExprMatchingFun func values) -> values @ rest + | _ -> rest + | TypeCast (expr = ExprMatchingFunFeedback func values) + | Lambda ( body = ExprMatchingFunFeedback func values) + | Delegate (body = ExprMatchingFunFeedback func values) -> + values @ rest + | ObjectExpr (members = members; baseCall = baseCall) -> + (members + |> List.collect (_.Body >> function ExprMatchingFunFeedback func values -> values)) + @ (baseCall |> Option.map(function ExprMatchingFunFeedback func values -> values) |> Option.defaultValue []) + @ rest + | Call (callee = ExprMatchingFunFeedback func calleeValues; info = { Args = ExprMatchingFun func infoValues }) -> + calleeValues @ infoValues @ rest + | CurriedApply (applied = ExprMatchingFunFeedback func values; args = ExprMatchingFun func argValues) -> + values @ argValues @ rest + | Operation (kind = operationKind) -> + match operationKind with + | Unary (operand = ExprMatchingFunFeedback func values) -> values @ rest + | Binary (left = ExprMatchingFunFeedback func left; right = ExprMatchingFunFeedback func right) + | Logical (left = ExprMatchingFunFeedback func left; right = ExprMatchingFunFeedback func right) -> left @ right @ rest + | Emit (info = { CallInfo = { Args = ExprMatchingFun func values } }) -> values @ rest + | DecisionTree (ExprMatchingFunFeedback func values, targets) -> + values @ + ( + targets + |> List.collect (snd >> function ExprMatchingFunFeedback func values -> values) + ) @ rest + | DecisionTreeSuccess (boundValues = ExprMatchingFun func values) -> + values @ rest + | Let (_, ExprMatchingFunFeedback func values, ExprMatchingFunFeedback func values2) -> values @ values2 @ rest + | LetRec (bindings, ExprMatchingFunFeedback func values) -> + (bindings |> List.collect (snd >> function ExprMatchingFunFeedback func values -> values)) + @ values @ rest + | Get (expr = ExprMatchingFunFeedback func values; kind = kind) -> + match kind with + | ExprGet (ExprMatchingFunFeedback func kindValues) -> values @ kindValues @ rest + | _ -> values @ rest + | Set (expr = (ExprMatchingFunFeedback func values); kind = kind) -> + match kind with + | ExprSet (ExprMatchingFunFeedback func exprValues) -> values @ exprValues @ rest + | _ -> values @ rest + | WhileLoop (guard = ExprMatchingFunFeedback func guardValues; body = ExprMatchingFunFeedback func bodyValues) -> guardValues @ bodyValues @ rest + | ForLoop ( start = ExprMatchingFunFeedback func startValues; limit = ExprMatchingFunFeedback func limitValues; body = ExprMatchingFunFeedback func bodyValues) -> + startValues @ limitValues @ bodyValues @ rest + | TryCatch (body = ExprMatchingFunFeedback func bodyValues; catch = catch; finalizer = finalizer) -> + bodyValues @ + (catch |> Option.map (snd >> function ExprMatchingFunFeedback func values -> values) |> Option.defaultValue []) @ + (finalizer |> Option.map(function ExprMatchingFunFeedback func values -> values) |> Option.defaultValue []) @ + rest + | IfThenElse (ExprMatchingFunFeedback func values, ExprMatchingFunFeedback func values2, ExprMatchingFunFeedback func values3, _) -> + values @ values2 @ values3 @ rest + | _ -> rest + type StringUtils = /// Trims JS reserved identifiers such as `'` and ``#` where # is some number diff --git a/Partas.Solid/Partas.Solid.fsproj b/Partas.Solid/Partas.Solid.fsproj index 89f7eaf..7b2b83c 100644 --- a/Partas.Solid/Partas.Solid.fsproj +++ b/Partas.Solid/Partas.Solid.fsproj @@ -16,8 +16,8 @@ Shayan Habibi, Vladimir Schur and Contributors Copyright (c) Shayan Habibi 2025, based on work by Vladimir Schur 2024 README.md - 2.1.0-alpha.6 - 2.1.0-alpha.6 + 2.1.0-alpha.7 + 2.1.0-alpha.7 From daa1fc4a275e35891d865452e21f30e829504301 Mon Sep 17 00:00:00 2001 From: cabboose Date: Wed, 10 Sep 2025 03:27:31 +0800 Subject: [PATCH 11/13] add(storybook): `decorator` custom operation for defining decorators --- Partas.Solid.FablePlugin/Storybook.fs | 178 ++++++++++++++------------ Partas.Solid/Storybook.fs | 42 ++++-- 2 files changed, 128 insertions(+), 92 deletions(-) diff --git a/Partas.Solid.FablePlugin/Storybook.fs b/Partas.Solid.FablePlugin/Storybook.fs index 6fa6014..b4bc650 100644 --- a/Partas.Solid.FablePlugin/Storybook.fs +++ b/Partas.Solid.FablePlugin/Storybook.fs @@ -498,6 +498,14 @@ module internal rec StorybookCases = { PropertyName = prop; Cases = matches |> List.distinct } ) +module internal rec StorybookDecorator = + let getDecorator (ctx: PluginContext) (expr: Expr) = + let predicate = function + | Lambda(name = Some (StartsWith "PARTAS_DECORATOR")) -> true + | _ -> false + findAndDiscardElse predicate expr + |> List.tryHead + |> Option.map (AST.transform ctx) module internal rec StorybookRender = let getRender (ctx: PluginContext) (expr: Expr) = @@ -512,60 +520,67 @@ module internal rec StorybookRender = module internal rec StorybookVariantsAndArgs = type RawVariantExpr = RawVariantExpr of variantName: string * expr: Expr - type Variant = Variant of variantName: string * args: (string * Expr) list - type VariantRender = VariantRender of variantName: string * render: Expr + type Variant = Variant of variantName: string * args: (string * Expr) list with + member this.Destructure = + let (Variant (name, args)) = this in name,args + member this.Name = + let (Variant(name,_)) = this in name + type VariantRender = VariantRender of variantName: string * render: Expr with + member this.Name = let (VariantRender(name, _)) = this in name + type VariantDecorator = VariantDecorator of variantName: string * decorator: Expr with + member this.Name = let (VariantDecorator(name, _)) = this in name + type VariantKind = + | Arg of Variant + | Render of VariantRender + | Decorator of VariantDecorator + member this.Name = + match this with + | Arg variant -> variant.Name + | Render variant -> variant.Name + | Decorator variant -> variant.Name + member this.Prop = + match this with + | Arg (Variant(_,expr)) -> + "args", AstUtils.Object expr + | Render(VariantRender(_,expr)) -> "render", expr + | Decorator(VariantDecorator(_, expr)) -> "decorators", AstUtils.ValueArray([expr]) + let getVariantDecorators (ctx: PluginContext) (expr: Expr) = + let predicate = function + | Lambda(arg = { Name = StartsWith "PARTAS_DECORATOR_BUILDER" }) -> true + | _ -> false + match expr with + | ExprMatchingFunFeedback predicate values -> + values + |> List.map(function + | Lambda(arg = arg; body = Sequential(TypeCast(expr = Value(kind = StringConstant(StartsWithTrimmed "PARTAS_DECORATOR_VARIANT" name))) :: exprs)) -> + VariantDecorator(name, Lambda(arg, Sequential exprs |> AST.transform ctx, None)) + | _ -> failwith "UNREACHABLE" ) let getVariantRenders (ctx: PluginContext) (expr: Expr) = - let predicate = - function - | Expr.Sequential (TypeCast (expr = Value (kind = StringConstant (StartsWith "PARTAS_RENDER_VARIANT"))) :: _) -> true + let predicate = function + | Lambda(arg = { Name = StartsWith "PARTAS_RENDER_BUILDER" }) -> true | _ -> false - - let recursiveDiscovery expr = - findAndDiscardElse predicate expr - |> List.map (fun expr -> - match expr with - | Expr.Sequential (TypeCast (expr = Value (kind = StringConstant (StartsWithTrimmed "PARTAS_RENDER_VARIANT" name))) :: exprs) -> - name, - let predicate = - function - | Lambda (name = Some "PARTAS_VARIANT_RENDER") -> true - | _ -> false - - List.collect (findAndDiscardElse predicate) exprs - |> List.head - |> AST.transform ctx - | _ -> failwith "Unreachable") - |> List.map VariantRender - - recursiveDiscovery expr - + match expr with + | ExprMatchingFunFeedback predicate values -> + values + |> List.map(function + | Lambda(arg = arg; body = Sequential(TypeCast(expr = Value(kind = StringConstant(StartsWithTrimmed "PARTAS_RENDER_VARIANT" name))) :: exprs)) -> + VariantRender(name,Lambda(arg, Sequential exprs |> AST.transform ctx, None)) + | _ -> failwith "UNREACHABLE" ) let getVariants (ctx: PluginContext) (expr: Expr) = - let predicate = - function - | Expr.Sequential (TypeCast (expr = Value (kind = StringConstant (StartsWith "PARTAS_VARIANT"))) :: _) -> true + let predicate = function + | Lambda(arg = { Name = StartsWith "PARTAS_ARG_BUILDER" }) -> true | _ -> false + let rawVariantExpressions = + match expr with + | ExprMatchingFunFeedback predicate values -> + values + |> List.map(function + | Lambda(body = Sequential(TypeCast(expr = Value(kind = StringConstant(StartsWithTrimmed "PARTAS_VARIANT" name))) :: exprs)) -> + RawVariantExpr(name, Sequential exprs) + | _ -> failwith "UNREACHABLE" + ) - let rec recursiveDiscovery expr = - findAndDiscardElse predicate expr - |> List.collect (function - | Expr.Sequential (_ :: exprs) as expr -> - expr - :: (exprs - |> List.collect recursiveDiscovery) - | e -> [ e ]) - - let extractVariantExprs = - function - | Sequential (nameExpr :: (Sequential (TypeCast (expr = expr) :: _) :: _)) -> - let variantName = - match nameExpr with - | TypeCast (expr = Value (kind = StringConstant (StartsWithTrimmed "PARTAS_VARIANT" variantName))) -> Some variantName - | _ -> None - - variantName - |> Option.map (fun variantName -> RawVariantExpr (variantName, expr)) - | _ -> None let processRawVariantExpr (RawVariantExpr (name, expr)) = let predicate = @@ -617,8 +632,7 @@ module internal rec StorybookVariantsAndArgs = Variant (name, args) - recursiveDiscovery expr - |> List.choose extractVariantExprs + rawVariantExpressions |> List.map processRawVariantExpr let getArgs (ctx: PluginContext) (expr: Expr) = @@ -819,43 +833,45 @@ module internal StorybookAST = // We reverse the list so the variants are in the same order // they were defined |> List.rev + |> List.map VariantKind.Arg let variantRenders = getVariantRenders ctx expr |> List.rev + |> List.map VariantKind.Render - let variantCombinations = - variants - |> List.map (function - | Variant (name, args) -> - variantRenders - |> List.tryFind ( - (function - | VariantRender (renderName, _) -> renderName) - >> (=) name - ) - |> function - | Some (VariantRender (_, render)) -> name, AstUtils.Object [ "args", AstUtils.Object args; "render", render ] - | None -> name, AstUtils.Object [ "args", AstUtils.Object args ]) - |> List.append ( - variantRenders - |> List.choose (function - | VariantRender (name, render) -> - if - variants - |> List.exists ( - (function - | Variant (vname, _) -> vname) - >> (=) name - ) - then - None - else - (name, AstUtils.Object [ "render", render ]) - |> Some) - ) + let variantDecorators = + getVariantDecorators ctx expr + |> List.rev + |> List.map VariantKind.Decorator + + let variantCollections = + let keyValuePair (variantKind: VariantKind) = + variantKind.Name,variantKind.Prop + [ + yield! variants + yield! variantRenders + yield! variantDecorators + ] |> List.map keyValuePair + |> fun keyVals -> + query { + for key,value in keyVals do + groupValBy value key + } + + + let variantCombinations = [ + + for group in variantCollections do + group.Key, AstUtils.Object [ + for value in group do + value + ] + ] // The render custom op let render = StorybookRender.getRender ctx expr + // The decorator custom op + let decorator = StorybookDecorator.getDecorator ctx expr |> Option.map (List.singleton >> AstUtils.ValueArray) // Creating the field data let fieldData = properties @@ -1253,6 +1269,8 @@ module internal StorybookAST = |> List.map (function | { Name = name; ArgType = expr } -> name, expr) ) + if decorator.IsSome then + "decorators", decorator.Value if render.IsSome then "render", render.Value "component", compExpr ] diff --git a/Partas.Solid/Storybook.fs b/Partas.Solid/Storybook.fs index b7a84b2..bff6d65 100644 --- a/Partas.Solid/Storybook.fs +++ b/Partas.Solid/Storybook.fs @@ -49,12 +49,13 @@ module Builder = ([] PARTAS_FIRST: StorybookFun<'T>, PARTAS_VARIANT: string, [] PARTAS_VARIANT_ARGS: ('T -> unit)) : StorybookFun<'T> = fun PARTAS_BUILDER -> - ignore ( - "PARTAS_VARIANT" - + PARTAS_VARIANT - ) - - ignore PARTAS_VARIANT_ARGS + fun (PARTAS_ARG_BUILDER: 'T) -> + ignore ( + "PARTAS_VARIANT" + + PARTAS_VARIANT + ) + PARTAS_ARG_BUILDER |> PARTAS_VARIANT_ARGS + |> ignore PARTAS_FIRST PARTAS_BUILDER member inline _.For @@ -80,12 +81,29 @@ module Builder = [] PARTAS_VARIANT_RENDER: 'T -> #Partas.Solid.Builder.HtmlElement ) : StorybookFun<'T> = fun PARTAS_BUILDER -> - ignore ( - "PARTAS_RENDER_VARIANT" - + PARTAS_RENDER_VARIANT - ) - - ignore PARTAS_VARIANT_RENDER + fun PARTAS_RENDER_BUILDER -> + ignore ( + "PARTAS_RENDER_VARIANT" + + PARTAS_RENDER_VARIANT + ) + PARTAS_RENDER_BUILDER |> PARTAS_VARIANT_RENDER + |> ignore + PARTAS_FIRST PARTAS_BUILDER + [] + member inline _.Decorator([] PARTAS_FIRST: StorybookFun<'T>, [] PARTAS_DECORATOR: (unit -> 'T) -> Partas.Solid.Builder.HtmlElement) = + fun PARTAS_BUILDER -> + ignore PARTAS_DECORATOR + PARTAS_FIRST PARTAS_BUILDER + [] + member inline _.Decorator([] PARTAS_FIRST: StorybookFun<'T>, PARTAS_DECORATOR_VARIANT: string, [] PARTAS_VARIANT_DECORATOR: (unit -> 'T) -> Partas.Solid.Builder.HtmlElement) = + fun PARTAS_BUILDER -> + fun PARTAS_DECORATOR_BUILDER -> + ignore ( + "PARTAS_DECORATOR_VARIANT" + + PARTAS_DECORATOR_VARIANT + ) + PARTAS_VARIANT_DECORATOR PARTAS_DECORATOR_BUILDER + |> ignore PARTAS_FIRST PARTAS_BUILDER type StorybookArgs<'T> with From 0c0393ce11b426f5b6741c18ab358d5c218520c0 Mon Sep 17 00:00:00 2001 From: cabboose Date: Wed, 10 Sep 2025 03:27:31 +0800 Subject: [PATCH 12/13] add(storybook): `decorator` custom operation for defining decorators --- Partas.Solid.FablePlugin/Storybook.fs | 389 ++++++++++++++++---------- Partas.Solid.FablePlugin/Utils.fs | 170 ++++++++--- Partas.Solid/Storybook.fs | 55 +++- 3 files changed, 412 insertions(+), 202 deletions(-) diff --git a/Partas.Solid.FablePlugin/Storybook.fs b/Partas.Solid.FablePlugin/Storybook.fs index 6fa6014..a46e6b7 100644 --- a/Partas.Solid.FablePlugin/Storybook.fs +++ b/Partas.Solid.FablePlugin/Storybook.fs @@ -297,7 +297,7 @@ module internal rec StorybookTypeRecursion = | [] -> [] | declaredType :: FilterNativeTypes ctx rest -> match declaredType with - | typ when typ.Entity.FullName.StartsWith("Partas.Solid.Tags") -> rest + | typ when typ.Entity.FullName.StartsWith ("Partas.Solid.Tags") -> rest | ent -> ent :: rest @@ -395,109 +395,155 @@ module internal rec StorybookCases = { PropertyName: string Cases: string list } - type CasesInfo = { - MatchExpr: Expr - CaseContainer: Expr - } + type CasesInfo = + { MatchExpr: Expr; CaseContainer: Expr } // When collecting cases, we should first be able to assembler // the type info and ident with a list of case expressions. - type CasesContext = { - Ident: Ident - Type: Type - CaseExprs: CasesInfo list - } - let private (|CaseProp|) (ctx: PluginContext): Expr -> string = function - | Get(kind = FieldGet({ Name = prop })) - | Call( info = { MemberRef = Some(MemberRef.MemberRefIs ctx MemberRefType.Getter) - & MemberRef.Option.PartasName ctx prop } ) -> - prop + type CasesContext = + { Ident: Ident + Type: Type + CaseExprs: CasesInfo list } + + let private (|CaseProp|) (ctx: PluginContext) : Expr -> string = + function + | Get (kind = FieldGet ({ Name = prop })) + | Call (info = { MemberRef = Some (MemberRef.MemberRefIs ctx MemberRefType.Getter) & MemberRef.Option.PartasName ctx prop }) -> prop | expr -> $"While processing a case matchValue expression, we encountered an unknown getter expression: {expr}" |> PluginContext.logWarning ctx + "ERROR" - let private (|CaseValues|) (ctx: PluginContext): Expr -> string list = function - | Value(StringConstant(prop), _) -> [ prop ] - | DecisionTree(CaseValues ctx values, targets) -> + + let private (|CaseValues|) (ctx: PluginContext) : Expr -> string list = + function + | Value (StringConstant (prop), _) -> [ prop ] + | DecisionTree (CaseValues ctx values, targets) -> let targets = - targets |> List.collect(snd >> function CaseValues ctx values -> values) - values @ targets - | IfThenElse(CaseValues ctx values,CaseValues ctx thens, CaseValues ctx elses,_) -> - values @ thens @ elses - | Operation(kind = Binary(left = CaseValues ctx left; right = CaseValues ctx right)) -> - left @ right + targets + |> List.collect ( + snd + >> function + | CaseValues ctx values -> values + ) + + values + @ targets + | IfThenElse (CaseValues ctx values, CaseValues ctx thens, CaseValues ctx elses, _) -> + values + @ thens + @ elses + | Operation (kind = Binary (left = CaseValues ctx left; right = CaseValues ctx right)) -> + left + @ right | _ -> [] - let private (|CaseSubExpression|_|) (ctx: PluginContext) (cases: CasesContext): Expr -> CasesContext option = function - | Let({ Name = StartsWith "matchValue" }, body: Expr, value: Expr) -> + let private (|CaseSubExpression|_|) (ctx: PluginContext) (cases: CasesContext) : Expr -> CasesContext option = + function + | Let ({ Name = StartsWith "matchValue" }, body: Expr, value: Expr) -> // the body is the actual expression/getter. - Some { - cases with - CaseExprs = { - MatchExpr = body - CaseContainer = value - } :: cases.CaseExprs - } + Some + { cases with + CaseExprs = + { MatchExpr = body + CaseContainer = value } + :: cases.CaseExprs } | _ -> None - let private (|CollectMatchersFeedback|) (ctx: PluginContext): Expr -> Expr list = function + let private (|CollectMatchersFeedback|) (ctx: PluginContext) : Expr -> Expr list = + function | expr -> - [ expr ] |> function CollectMatchers ctx values -> values + [ expr ] + |> function + | CollectMatchers ctx values -> values - let private (|CollectMatchers|) (ctx: PluginContext): Expr list -> Expr list = function + let private (|CollectMatchers|) (ctx: PluginContext) : Expr list -> Expr list = + function | [] -> [] - | Sequential(CollectMatchers ctx left) :: CollectMatchers ctx right -> - left @ right + | Sequential (CollectMatchers ctx left) :: CollectMatchers ctx right -> + left + @ right | expr :: CollectMatchers ctx rest -> match expr with - | Let({ Name = StartsWith "matchValue" }, body, value) -> - expr :: rest - | Call(info = { Args = CollectMatchers ctx values }) -> - values @ rest - | CurriedApply(CollectMatchersFeedback ctx values, CollectMatchers ctx otherValues, _, _) -> - values @ otherValues @ rest - | Lambda(body = CollectMatchersFeedback ctx values) - | Delegate(body = CollectMatchersFeedback ctx values) -> - values @ rest + | Let ({ Name = StartsWith "matchValue" }, body, value) -> + expr + :: rest + | Call (info = { Args = CollectMatchers ctx values }) -> + values + @ rest + | CurriedApply (CollectMatchersFeedback ctx values, CollectMatchers ctx otherValues, _, _) -> + values + @ otherValues + @ rest + | Lambda (body = CollectMatchersFeedback ctx values) + | Delegate (body = CollectMatchersFeedback ctx values) -> + values + @ rest | _ -> rest - let getCases (ctx: PluginContext) (entityTyp: Type) = - let predicate = function Lambda(name = Some(StartsWith "PARTAS_CASES")) -> true | _ -> false + let getCases (ctx: PluginContext) (entityTyp: Type) = + let predicate = + function + | Lambda (name = Some (StartsWith "PARTAS_CASES")) -> true + | _ -> false + function | ExprMatchingFunFeedback predicate caseExprs -> caseExprs - |> List.collect(function - | Lambda(arg = ident; body = expr) -> - let caseContext = { - Ident = ident - Type = entityTyp - CaseExprs = [] - } - let predicate = function - | CaseSubExpression ctx caseContext _ -> true - | _ -> false - match expr with - | ExprMatchingFunFeedback predicate caseSubExprs -> - let folder = fun caseContext expr -> - match expr with - | CaseSubExpression ctx caseContext value -> - value - | _ -> caseContext - - caseSubExprs - |> List.fold folder caseContext - | e -> failwith $"This expr should have been unreachable inside the ExprMatchingFunFeedback loop. Please report this and the reproducing code. Expr: {e}" - >> _.CaseExprs + |> List.collect ( + function + | Lambda (arg = ident; body = expr) -> + let caseContext = + { Ident = ident + Type = entityTyp + CaseExprs = [] } + + let predicate = + function + | CaseSubExpression ctx caseContext _ -> true + | _ -> false + + match expr with + | ExprMatchingFunFeedback predicate caseSubExprs -> + let folder = + fun caseContext expr -> + match expr with + | CaseSubExpression ctx caseContext value -> value + | _ -> caseContext + + caseSubExprs + |> List.fold folder caseContext + | e -> + failwith + $"This expr should have been unreachable inside the ExprMatchingFunFeedback loop. Please report this and the reproducing code. Expr: {e}" + >> _.CaseExprs ) - |> List.map(fun caseInfo -> + |> List.map (fun caseInfo -> let prop = - caseInfo.MatchExpr |> function CaseProp ctx prop -> prop + caseInfo.MatchExpr + |> function + | CaseProp ctx prop -> prop + let matches = - caseInfo.CaseContainer |> function + caseInfo.CaseContainer + |> function | CaseValues ctx values -> values - { PropertyName = prop; Cases = matches |> List.distinct } - ) + { PropertyName = prop + Cases = + matches + |> List.distinct }) + +module internal rec StorybookDecorator = + let getDecorator (ctx: PluginContext) (expr: Expr) = + let predicate = + function + | Lambda (name = Some (StartsWith "PARTAS_DECORATOR")) -> true + | _ -> false + + findAndDiscardElse predicate expr + |> List.tryHead + |> Option.map (AST.transform ctx) module internal rec StorybookRender = let getRender (ctx: PluginContext) (expr: Expr) = @@ -512,60 +558,103 @@ module internal rec StorybookRender = module internal rec StorybookVariantsAndArgs = type RawVariantExpr = RawVariantExpr of variantName: string * expr: Expr - type Variant = Variant of variantName: string * args: (string * Expr) list - type VariantRender = VariantRender of variantName: string * render: Expr - let getVariantRenders (ctx: PluginContext) (expr: Expr) = + type Variant = + | Variant of variantName: string * args: (string * Expr) list + + member this.Destructure = let (Variant (name, args)) = this in name, args + member this.Name = let (Variant (name, _)) = this in name + + type VariantRender = + | VariantRender of variantName: string * render: Expr + + member this.Name = let (VariantRender (name, _)) = this in name + + type VariantDecorator = + | VariantDecorator of variantName: string * decorator: Expr + + member this.Name = let (VariantDecorator (name, _)) = this in name + + type VariantKind = + | Arg of Variant + | Render of VariantRender + | Decorator of VariantDecorator + + member this.Name = + match this with + | Arg variant -> variant.Name + | Render variant -> variant.Name + | Decorator variant -> variant.Name + + member this.Prop = + match this with + | Arg (Variant (_, expr)) -> "args", AstUtils.Object expr + | Render (VariantRender (_, expr)) -> "render", expr + | Decorator (VariantDecorator (_, expr)) -> "decorators", AstUtils.ValueArray ([ expr ]) + + let getVariantDecorators (ctx: PluginContext) (expr: Expr) = let predicate = function - | Expr.Sequential (TypeCast (expr = Value (kind = StringConstant (StartsWith "PARTAS_RENDER_VARIANT"))) :: _) -> true + | Lambda (arg = { Name = StartsWith "PARTAS_DECORATOR_BUILDER" }) -> true | _ -> false - let recursiveDiscovery expr = - findAndDiscardElse predicate expr - |> List.map (fun expr -> - match expr with - | Expr.Sequential (TypeCast (expr = Value (kind = StringConstant (StartsWithTrimmed "PARTAS_RENDER_VARIANT" name))) :: exprs) -> - name, - let predicate = - function - | Lambda (name = Some "PARTAS_VARIANT_RENDER") -> true - | _ -> false + match expr with + | ExprMatchingFunFeedback predicate values -> + values + |> List.map (function + | Lambda ( + arg = arg + body = Sequential (TypeCast (expr = Value (kind = StringConstant (StartsWithTrimmed "PARTAS_DECORATOR_VARIANT" name))) :: exprs)) -> + VariantDecorator ( + name, + Lambda ( + arg, + Sequential exprs + |> AST.transform ctx, + None + ) + ) + | _ -> failwith "UNREACHABLE") - List.collect (findAndDiscardElse predicate) exprs - |> List.head - |> AST.transform ctx - | _ -> failwith "Unreachable") - |> List.map VariantRender + let getVariantRenders (ctx: PluginContext) (expr: Expr) = + let predicate = + function + | Lambda (arg = { Name = StartsWith "PARTAS_RENDER_BUILDER" }) -> true + | _ -> false - recursiveDiscovery expr + match expr with + | ExprMatchingFunFeedback predicate values -> + values + |> List.map (function + | Lambda ( + arg = arg + body = Sequential (TypeCast (expr = Value (kind = StringConstant (StartsWithTrimmed "PARTAS_RENDER_VARIANT" name))) :: exprs)) -> + VariantRender ( + name, + Lambda ( + arg, + Sequential exprs + |> AST.transform ctx, + None + ) + ) + | _ -> failwith "UNREACHABLE") let getVariants (ctx: PluginContext) (expr: Expr) = let predicate = function - | Expr.Sequential (TypeCast (expr = Value (kind = StringConstant (StartsWith "PARTAS_VARIANT"))) :: _) -> true + | Lambda (arg = { Name = StartsWith "PARTAS_ARG_BUILDER" }) -> true | _ -> false - let rec recursiveDiscovery expr = - findAndDiscardElse predicate expr - |> List.collect (function - | Expr.Sequential (_ :: exprs) as expr -> - expr - :: (exprs - |> List.collect recursiveDiscovery) - | e -> [ e ]) - - let extractVariantExprs = - function - | Sequential (nameExpr :: (Sequential (TypeCast (expr = expr) :: _) :: _)) -> - let variantName = - match nameExpr with - | TypeCast (expr = Value (kind = StringConstant (StartsWithTrimmed "PARTAS_VARIANT" variantName))) -> Some variantName - | _ -> None + let rawVariantExpressions = + match expr with + | ExprMatchingFunFeedback predicate values -> + values + |> List.map (function + | Lambda (body = Sequential (TypeCast (expr = Value (kind = StringConstant (StartsWithTrimmed "PARTAS_VARIANT" name))) :: exprs)) -> + RawVariantExpr (name, Sequential exprs) + | _ -> failwith "UNREACHABLE") - variantName - |> Option.map (fun variantName -> RawVariantExpr (variantName, expr)) - | _ -> None let processRawVariantExpr (RawVariantExpr (name, expr)) = let predicate = @@ -617,8 +706,7 @@ module internal rec StorybookVariantsAndArgs = Variant (name, args) - recursiveDiscovery expr - |> List.choose extractVariantExprs + rawVariantExpressions |> List.map processRawVariantExpr let getArgs (ctx: PluginContext) (expr: Expr) = @@ -819,43 +907,48 @@ module internal StorybookAST = // We reverse the list so the variants are in the same order // they were defined |> List.rev + |> List.map VariantKind.Arg let variantRenders = getVariantRenders ctx expr |> List.rev + |> List.map VariantKind.Render + + let variantDecorators = + getVariantDecorators ctx expr + |> List.rev + |> List.map VariantKind.Decorator + + let variantCollections = + let keyValuePair (variantKind: VariantKind) = + variantKind.Name, variantKind.Prop + + [ yield! variants; yield! variantRenders; yield! variantDecorators ] + |> List.map keyValuePair + |> fun keyVals -> + query { + for key, value in keyVals do + groupValBy value key + } + let variantCombinations = - variants - |> List.map (function - | Variant (name, args) -> - variantRenders - |> List.tryFind ( - (function - | VariantRender (renderName, _) -> renderName) - >> (=) name - ) - |> function - | Some (VariantRender (_, render)) -> name, AstUtils.Object [ "args", AstUtils.Object args; "render", render ] - | None -> name, AstUtils.Object [ "args", AstUtils.Object args ]) - |> List.append ( - variantRenders - |> List.choose (function - | VariantRender (name, render) -> - if - variants - |> List.exists ( - (function - | Variant (vname, _) -> vname) - >> (=) name - ) - then - None - else - (name, AstUtils.Object [ "render", render ]) - |> Some) - ) + [ + + for group in variantCollections do + group.Key, + AstUtils.Object + [ for value in group do + value ] ] // The render custom op let render = StorybookRender.getRender ctx expr + // The decorator custom op + let decorator = + StorybookDecorator.getDecorator ctx expr + |> Option.map ( + List.singleton + >> AstUtils.ValueArray + ) // Creating the field data let fieldData = properties @@ -1253,6 +1346,8 @@ module internal StorybookAST = |> List.map (function | { Name = name; ArgType = expr } -> name, expr) ) + if decorator.IsSome then + "decorators", decorator.Value if render.IsSome then "render", render.Value "component", compExpr ] diff --git a/Partas.Solid.FablePlugin/Utils.fs b/Partas.Solid.FablePlugin/Utils.fs index 39021a8..557af96 100644 --- a/Partas.Solid.FablePlugin/Utils.fs +++ b/Partas.Solid.FablePlugin/Utils.fs @@ -493,88 +493,168 @@ module Expr = |> filterList | _ -> [] - let rec (|ExprMatchingFunFeedback|) (func: Expr -> bool): Expr -> Expr list = function + let rec (|ExprMatchingFunFeedback|) (func: Expr -> bool) : Expr -> Expr list = + function | expr when func expr -> [ expr ] | expr -> match [ expr ] with | ExprMatchingFun func result -> result - and (|ExprMatchingFun|) (func: Expr -> bool): Expr list -> Expr list = function + + and (|ExprMatchingFun|) (func: Expr -> bool) : Expr list -> Expr list = + function | [] -> [] | expr :: ExprMatchingFun func rest when func expr -> - expr :: rest - | Sequential(ExprMatchingFun func values) :: ExprMatchingFun func rest -> - values @ rest + expr + :: rest + | Sequential (ExprMatchingFun func values) :: ExprMatchingFun func rest -> + values + @ rest | expr :: ExprMatchingFun func rest -> match expr with | Value (kind, range) -> match kind with | StringTemplate (tag = tag; values = ExprMatchingFun func values) -> match tag with - | Some(ExprMatchingFunFeedback func tagValues) -> - tagValues @ values @ rest - | _ -> values @ rest - | NewOption (value = Some(ExprMatchingFunFeedback func values)) -> values @ rest - | NewArray (newKind = newKind ) -> + | Some (ExprMatchingFunFeedback func tagValues) -> + tagValues + @ values + @ rest + | _ -> + values + @ rest + | NewOption (value = Some (ExprMatchingFunFeedback func values)) -> + values + @ rest + | NewArray (newKind = newKind) -> match newKind with | ArrayAlloc (ExprMatchingFunFeedback func values) | ArrayFrom (ExprMatchingFunFeedback func values) - | ArrayValues (ExprMatchingFun func values) -> values @ rest - | NewList (Some(ExprMatchingFunFeedback func left, ExprMatchingFunFeedback func right), _) -> - left @ right @ rest + | ArrayValues (ExprMatchingFun func values) -> + values + @ rest + | NewList (Some (ExprMatchingFunFeedback func left, ExprMatchingFunFeedback func right), _) -> + left + @ right + @ rest | NewTuple (values = ExprMatchingFun func values) | NewRecord (values = ExprMatchingFun func values) | NewAnonymousRecord (values = ExprMatchingFun func values) - | NewUnion (values = ExprMatchingFun func values) -> values @ rest + | NewUnion (values = ExprMatchingFun func values) -> + values + @ rest | _ -> rest | TypeCast (expr = ExprMatchingFunFeedback func values) - | Lambda ( body = ExprMatchingFunFeedback func values) + | Lambda (body = ExprMatchingFunFeedback func values) | Delegate (body = ExprMatchingFunFeedback func values) -> - values @ rest - | ObjectExpr (members = members; baseCall = baseCall) -> + values + @ rest + | ObjectExpr (members = members; baseCall = baseCall) -> (members - |> List.collect (_.Body >> function ExprMatchingFunFeedback func values -> values)) - @ (baseCall |> Option.map(function ExprMatchingFunFeedback func values -> values) |> Option.defaultValue []) + |> List.collect ( + _.Body + >> function + | ExprMatchingFunFeedback func values -> values + )) + @ (baseCall + |> Option.map (function + | ExprMatchingFunFeedback func values -> values) + |> Option.defaultValue []) @ rest | Call (callee = ExprMatchingFunFeedback func calleeValues; info = { Args = ExprMatchingFun func infoValues }) -> - calleeValues @ infoValues @ rest + calleeValues + @ infoValues + @ rest | CurriedApply (applied = ExprMatchingFunFeedback func values; args = ExprMatchingFun func argValues) -> - values @ argValues @ rest + values + @ argValues + @ rest | Operation (kind = operationKind) -> match operationKind with - | Unary (operand = ExprMatchingFunFeedback func values) -> values @ rest + | Unary (operand = ExprMatchingFunFeedback func values) -> + values + @ rest | Binary (left = ExprMatchingFunFeedback func left; right = ExprMatchingFunFeedback func right) - | Logical (left = ExprMatchingFunFeedback func left; right = ExprMatchingFunFeedback func right) -> left @ right @ rest - | Emit (info = { CallInfo = { Args = ExprMatchingFun func values } }) -> values @ rest + | Logical (left = ExprMatchingFunFeedback func left; right = ExprMatchingFunFeedback func right) -> + left + @ right + @ rest + | Emit (info = { CallInfo = { Args = ExprMatchingFun func values } }) -> + values + @ rest | DecisionTree (ExprMatchingFunFeedback func values, targets) -> - values @ - ( - targets - |> List.collect (snd >> function ExprMatchingFunFeedback func values -> values) - ) @ rest + values + @ (targets + |> List.collect ( + snd + >> function + | ExprMatchingFunFeedback func values -> values + )) + @ rest | DecisionTreeSuccess (boundValues = ExprMatchingFun func values) -> - values @ rest - | Let (_, ExprMatchingFunFeedback func values, ExprMatchingFunFeedback func values2) -> values @ values2 @ rest + values + @ rest + | Let (_, ExprMatchingFunFeedback func values, ExprMatchingFunFeedback func values2) -> + values + @ values2 + @ rest | LetRec (bindings, ExprMatchingFunFeedback func values) -> - (bindings |> List.collect (snd >> function ExprMatchingFunFeedback func values -> values)) - @ values @ rest + (bindings + |> List.collect ( + snd + >> function + | ExprMatchingFunFeedback func values -> values + )) + @ values + @ rest | Get (expr = ExprMatchingFunFeedback func values; kind = kind) -> match kind with - | ExprGet (ExprMatchingFunFeedback func kindValues) -> values @ kindValues @ rest - | _ -> values @ rest + | ExprGet (ExprMatchingFunFeedback func kindValues) -> + values + @ kindValues + @ rest + | _ -> + values + @ rest | Set (expr = (ExprMatchingFunFeedback func values); kind = kind) -> match kind with - | ExprSet (ExprMatchingFunFeedback func exprValues) -> values @ exprValues @ rest - | _ -> values @ rest - | WhileLoop (guard = ExprMatchingFunFeedback func guardValues; body = ExprMatchingFunFeedback func bodyValues) -> guardValues @ bodyValues @ rest - | ForLoop ( start = ExprMatchingFunFeedback func startValues; limit = ExprMatchingFunFeedback func limitValues; body = ExprMatchingFunFeedback func bodyValues) -> - startValues @ limitValues @ bodyValues @ rest + | ExprSet (ExprMatchingFunFeedback func exprValues) -> + values + @ exprValues + @ rest + | _ -> + values + @ rest + | WhileLoop (guard = ExprMatchingFunFeedback func guardValues; body = ExprMatchingFunFeedback func bodyValues) -> + guardValues + @ bodyValues + @ rest + | ForLoop ( + start = ExprMatchingFunFeedback func startValues + limit = ExprMatchingFunFeedback func limitValues + body = ExprMatchingFunFeedback func bodyValues) -> + startValues + @ limitValues + @ bodyValues + @ rest | TryCatch (body = ExprMatchingFunFeedback func bodyValues; catch = catch; finalizer = finalizer) -> - bodyValues @ - (catch |> Option.map (snd >> function ExprMatchingFunFeedback func values -> values) |> Option.defaultValue []) @ - (finalizer |> Option.map(function ExprMatchingFunFeedback func values -> values) |> Option.defaultValue []) @ - rest + bodyValues + @ (catch + |> Option.map ( + snd + >> function + | ExprMatchingFunFeedback func values -> values + ) + |> Option.defaultValue []) + @ (finalizer + |> Option.map (function + | ExprMatchingFunFeedback func values -> values) + |> Option.defaultValue []) + @ rest | IfThenElse (ExprMatchingFunFeedback func values, ExprMatchingFunFeedback func values2, ExprMatchingFunFeedback func values3, _) -> - values @ values2 @ values3 @ rest + values + @ values2 + @ values3 + @ rest | _ -> rest diff --git a/Partas.Solid/Storybook.fs b/Partas.Solid/Storybook.fs index b7a84b2..a0ae180 100644 --- a/Partas.Solid/Storybook.fs +++ b/Partas.Solid/Storybook.fs @@ -49,12 +49,16 @@ module Builder = ([] PARTAS_FIRST: StorybookFun<'T>, PARTAS_VARIANT: string, [] PARTAS_VARIANT_ARGS: ('T -> unit)) : StorybookFun<'T> = fun PARTAS_BUILDER -> - ignore ( - "PARTAS_VARIANT" - + PARTAS_VARIANT - ) + fun (PARTAS_ARG_BUILDER: 'T) -> + ignore ( + "PARTAS_VARIANT" + + PARTAS_VARIANT + ) + + PARTAS_ARG_BUILDER + |> PARTAS_VARIANT_ARGS + |> ignore - ignore PARTAS_VARIANT_ARGS PARTAS_FIRST PARTAS_BUILDER member inline _.For @@ -80,12 +84,43 @@ module Builder = [] PARTAS_VARIANT_RENDER: 'T -> #Partas.Solid.Builder.HtmlElement ) : StorybookFun<'T> = fun PARTAS_BUILDER -> - ignore ( - "PARTAS_RENDER_VARIANT" - + PARTAS_RENDER_VARIANT - ) + fun PARTAS_RENDER_BUILDER -> + ignore ( + "PARTAS_RENDER_VARIANT" + + PARTAS_RENDER_VARIANT + ) + + PARTAS_RENDER_BUILDER + |> PARTAS_VARIANT_RENDER + |> ignore + + PARTAS_FIRST PARTAS_BUILDER + + [] + member inline _.Decorator + ([] PARTAS_FIRST: StorybookFun<'T>, [] PARTAS_DECORATOR: (unit -> 'T) -> Partas.Solid.Builder.HtmlElement) + = + fun PARTAS_BUILDER -> + ignore PARTAS_DECORATOR + PARTAS_FIRST PARTAS_BUILDER + + [] + member inline _.Decorator + ( + [] PARTAS_FIRST: StorybookFun<'T>, + PARTAS_DECORATOR_VARIANT: string, + [] PARTAS_VARIANT_DECORATOR: (unit -> 'T) -> Partas.Solid.Builder.HtmlElement + ) = + fun PARTAS_BUILDER -> + fun PARTAS_DECORATOR_BUILDER -> + ignore ( + "PARTAS_DECORATOR_VARIANT" + + PARTAS_DECORATOR_VARIANT + ) + + PARTAS_VARIANT_DECORATOR PARTAS_DECORATOR_BUILDER + |> ignore - ignore PARTAS_VARIANT_RENDER PARTAS_FIRST PARTAS_BUILDER type StorybookArgs<'T> with From 0e7b19adc0d740b52216d256e22461f597db15b2 Mon Sep 17 00:00:00 2001 From: cabboose Date: Thu, 11 Sep 2025 16:37:52 +0800 Subject: [PATCH 13/13] feat: storybook support --- Partas.Solid.FablePlugin/Partas.Solid.FablePlugin.fsproj | 4 ++-- Partas.Solid/Partas.Solid.fsproj | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/Partas.Solid.FablePlugin/Partas.Solid.FablePlugin.fsproj b/Partas.Solid.FablePlugin/Partas.Solid.FablePlugin.fsproj index ef14eae..68326ae 100644 --- a/Partas.Solid.FablePlugin/Partas.Solid.FablePlugin.fsproj +++ b/Partas.Solid.FablePlugin/Partas.Solid.FablePlugin.fsproj @@ -13,8 +13,8 @@ MIT Shayan Habibi based on work by Vladimir Schur and contributors Copyright (c) Shayan Habibi 2025 - 2.1.0-alpha.7 - 2.1.0-alpha.7 + 2.1.0 + 2.1.0 diff --git a/Partas.Solid/Partas.Solid.fsproj b/Partas.Solid/Partas.Solid.fsproj index 7b2b83c..c1f301c 100644 --- a/Partas.Solid/Partas.Solid.fsproj +++ b/Partas.Solid/Partas.Solid.fsproj @@ -16,8 +16,8 @@ Shayan Habibi, Vladimir Schur and Contributors Copyright (c) Shayan Habibi 2025, based on work by Vladimir Schur 2024 README.md - 2.1.0-alpha.7 - 2.1.0-alpha.7 + 2.1.0 + 2.1.0