Skip to content

Commit daa1fc4

Browse files
committed
add(storybook): decorator custom operation for defining decorators
1 parent 37b4f30 commit daa1fc4

File tree

2 files changed

+128
-92
lines changed

2 files changed

+128
-92
lines changed

Partas.Solid.FablePlugin/Storybook.fs

Lines changed: 98 additions & 80 deletions
Original file line numberDiff line numberDiff line change
@@ -498,6 +498,14 @@ module internal rec StorybookCases =
498498
{ PropertyName = prop; Cases = matches |> List.distinct }
499499
)
500500

501+
module internal rec StorybookDecorator =
502+
let getDecorator (ctx: PluginContext) (expr: Expr) =
503+
let predicate = function
504+
| Lambda(name = Some (StartsWith "PARTAS_DECORATOR")) -> true
505+
| _ -> false
506+
findAndDiscardElse predicate expr
507+
|> List.tryHead
508+
|> Option.map (AST.transform ctx)
501509

502510
module internal rec StorybookRender =
503511
let getRender (ctx: PluginContext) (expr: Expr) =
@@ -512,60 +520,67 @@ module internal rec StorybookRender =
512520

513521
module internal rec StorybookVariantsAndArgs =
514522
type RawVariantExpr = RawVariantExpr of variantName: string * expr: Expr
515-
type Variant = Variant of variantName: string * args: (string * Expr) list
516-
type VariantRender = VariantRender of variantName: string * render: Expr
523+
type Variant = Variant of variantName: string * args: (string * Expr) list with
524+
member this.Destructure =
525+
let (Variant (name, args)) = this in name,args
526+
member this.Name =
527+
let (Variant(name,_)) = this in name
528+
type VariantRender = VariantRender of variantName: string * render: Expr with
529+
member this.Name = let (VariantRender(name, _)) = this in name
530+
type VariantDecorator = VariantDecorator of variantName: string * decorator: Expr with
531+
member this.Name = let (VariantDecorator(name, _)) = this in name
532+
type VariantKind =
533+
| Arg of Variant
534+
| Render of VariantRender
535+
| Decorator of VariantDecorator
536+
member this.Name =
537+
match this with
538+
| Arg variant -> variant.Name
539+
| Render variant -> variant.Name
540+
| Decorator variant -> variant.Name
541+
member this.Prop =
542+
match this with
543+
| Arg (Variant(_,expr)) ->
544+
"args", AstUtils.Object expr
545+
| Render(VariantRender(_,expr)) -> "render", expr
546+
| Decorator(VariantDecorator(_, expr)) -> "decorators", AstUtils.ValueArray([expr])
547+
let getVariantDecorators (ctx: PluginContext) (expr: Expr) =
548+
let predicate = function
549+
| Lambda(arg = { Name = StartsWith "PARTAS_DECORATOR_BUILDER" }) -> true
550+
| _ -> false
551+
match expr with
552+
| ExprMatchingFunFeedback predicate values ->
553+
values
554+
|> List.map(function
555+
| Lambda(arg = arg; body = Sequential(TypeCast(expr = Value(kind = StringConstant(StartsWithTrimmed "PARTAS_DECORATOR_VARIANT" name))) :: exprs)) ->
556+
VariantDecorator(name, Lambda(arg, Sequential exprs |> AST.transform ctx, None))
557+
| _ -> failwith "UNREACHABLE" )
517558

518559
let getVariantRenders (ctx: PluginContext) (expr: Expr) =
519-
let predicate =
520-
function
521-
| Expr.Sequential (TypeCast (expr = Value (kind = StringConstant (StartsWith "PARTAS_RENDER_VARIANT"))) :: _) -> true
560+
let predicate = function
561+
| Lambda(arg = { Name = StartsWith "PARTAS_RENDER_BUILDER" }) -> true
522562
| _ -> false
523-
524-
let recursiveDiscovery expr =
525-
findAndDiscardElse predicate expr
526-
|> List.map (fun expr ->
527-
match expr with
528-
| Expr.Sequential (TypeCast (expr = Value (kind = StringConstant (StartsWithTrimmed "PARTAS_RENDER_VARIANT" name))) :: exprs) ->
529-
name,
530-
let predicate =
531-
function
532-
| Lambda (name = Some "PARTAS_VARIANT_RENDER") -> true
533-
| _ -> false
534-
535-
List.collect (findAndDiscardElse predicate) exprs
536-
|> List.head
537-
|> AST.transform ctx
538-
| _ -> failwith "Unreachable")
539-
|> List.map VariantRender
540-
541-
recursiveDiscovery expr
542-
563+
match expr with
564+
| ExprMatchingFunFeedback predicate values ->
565+
values
566+
|> List.map(function
567+
| Lambda(arg = arg; body = Sequential(TypeCast(expr = Value(kind = StringConstant(StartsWithTrimmed "PARTAS_RENDER_VARIANT" name))) :: exprs)) ->
568+
VariantRender(name,Lambda(arg, Sequential exprs |> AST.transform ctx, None))
569+
| _ -> failwith "UNREACHABLE" )
543570
let getVariants (ctx: PluginContext) (expr: Expr) =
544-
let predicate =
545-
function
546-
| Expr.Sequential (TypeCast (expr = Value (kind = StringConstant (StartsWith "PARTAS_VARIANT"))) :: _) -> true
571+
let predicate = function
572+
| Lambda(arg = { Name = StartsWith "PARTAS_ARG_BUILDER" }) -> true
547573
| _ -> false
574+
let rawVariantExpressions =
575+
match expr with
576+
| ExprMatchingFunFeedback predicate values ->
577+
values
578+
|> List.map(function
579+
| Lambda(body = Sequential(TypeCast(expr = Value(kind = StringConstant(StartsWithTrimmed "PARTAS_VARIANT" name))) :: exprs)) ->
580+
RawVariantExpr(name, Sequential exprs)
581+
| _ -> failwith "UNREACHABLE"
582+
)
548583

549-
let rec recursiveDiscovery expr =
550-
findAndDiscardElse predicate expr
551-
|> List.collect (function
552-
| Expr.Sequential (_ :: exprs) as expr ->
553-
expr
554-
:: (exprs
555-
|> List.collect recursiveDiscovery)
556-
| e -> [ e ])
557-
558-
let extractVariantExprs =
559-
function
560-
| Sequential (nameExpr :: (Sequential (TypeCast (expr = expr) :: _) :: _)) ->
561-
let variantName =
562-
match nameExpr with
563-
| TypeCast (expr = Value (kind = StringConstant (StartsWithTrimmed "PARTAS_VARIANT" variantName))) -> Some variantName
564-
| _ -> None
565-
566-
variantName
567-
|> Option.map (fun variantName -> RawVariantExpr (variantName, expr))
568-
| _ -> None
569584

570585
let processRawVariantExpr (RawVariantExpr (name, expr)) =
571586
let predicate =
@@ -617,8 +632,7 @@ module internal rec StorybookVariantsAndArgs =
617632

618633
Variant (name, args)
619634

620-
recursiveDiscovery expr
621-
|> List.choose extractVariantExprs
635+
rawVariantExpressions
622636
|> List.map processRawVariantExpr
623637

624638
let getArgs (ctx: PluginContext) (expr: Expr) =
@@ -819,43 +833,45 @@ module internal StorybookAST =
819833
// We reverse the list so the variants are in the same order
820834
// they were defined
821835
|> List.rev
836+
|> List.map VariantKind.Arg
822837

823838
let variantRenders =
824839
getVariantRenders ctx expr
825840
|> List.rev
841+
|> List.map VariantKind.Render
826842

827-
let variantCombinations =
828-
variants
829-
|> List.map (function
830-
| Variant (name, args) ->
831-
variantRenders
832-
|> List.tryFind (
833-
(function
834-
| VariantRender (renderName, _) -> renderName)
835-
>> (=) name
836-
)
837-
|> function
838-
| Some (VariantRender (_, render)) -> name, AstUtils.Object [ "args", AstUtils.Object args; "render", render ]
839-
| None -> name, AstUtils.Object [ "args", AstUtils.Object args ])
840-
|> List.append (
841-
variantRenders
842-
|> List.choose (function
843-
| VariantRender (name, render) ->
844-
if
845-
variants
846-
|> List.exists (
847-
(function
848-
| Variant (vname, _) -> vname)
849-
>> (=) name
850-
)
851-
then
852-
None
853-
else
854-
(name, AstUtils.Object [ "render", render ])
855-
|> Some)
856-
)
843+
let variantDecorators =
844+
getVariantDecorators ctx expr
845+
|> List.rev
846+
|> List.map VariantKind.Decorator
847+
848+
let variantCollections =
849+
let keyValuePair (variantKind: VariantKind) =
850+
variantKind.Name,variantKind.Prop
851+
[
852+
yield! variants
853+
yield! variantRenders
854+
yield! variantDecorators
855+
] |> List.map keyValuePair
856+
|> fun keyVals ->
857+
query {
858+
for key,value in keyVals do
859+
groupValBy value key
860+
}
861+
862+
863+
let variantCombinations = [
864+
865+
for group in variantCollections do
866+
group.Key, AstUtils.Object [
867+
for value in group do
868+
value
869+
]
870+
]
857871
// The render custom op
858872
let render = StorybookRender.getRender ctx expr
873+
// The decorator custom op
874+
let decorator = StorybookDecorator.getDecorator ctx expr |> Option.map (List.singleton >> AstUtils.ValueArray)
859875
// Creating the field data
860876
let fieldData =
861877
properties
@@ -1253,6 +1269,8 @@ module internal StorybookAST =
12531269
|> List.map (function
12541270
| { Name = name; ArgType = expr } -> name, expr)
12551271
)
1272+
if decorator.IsSome then
1273+
"decorators", decorator.Value
12561274
if render.IsSome then
12571275
"render", render.Value
12581276
"component", compExpr ]

Partas.Solid/Storybook.fs

Lines changed: 30 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -49,12 +49,13 @@ module Builder =
4949
([<InlineIfLambda>] PARTAS_FIRST: StorybookFun<'T>, PARTAS_VARIANT: string, [<InlineIfLambda>] PARTAS_VARIANT_ARGS: ('T -> unit))
5050
: StorybookFun<'T> =
5151
fun PARTAS_BUILDER ->
52-
ignore (
53-
"PARTAS_VARIANT"
54-
+ PARTAS_VARIANT
55-
)
56-
57-
ignore PARTAS_VARIANT_ARGS
52+
fun (PARTAS_ARG_BUILDER: 'T) ->
53+
ignore (
54+
"PARTAS_VARIANT"
55+
+ PARTAS_VARIANT
56+
)
57+
PARTAS_ARG_BUILDER |> PARTAS_VARIANT_ARGS
58+
|> ignore
5859
PARTAS_FIRST PARTAS_BUILDER
5960

6061
member inline _.For
@@ -80,12 +81,29 @@ module Builder =
8081
[<InlineIfLambda>] PARTAS_VARIANT_RENDER: 'T -> #Partas.Solid.Builder.HtmlElement
8182
) : StorybookFun<'T> =
8283
fun PARTAS_BUILDER ->
83-
ignore (
84-
"PARTAS_RENDER_VARIANT"
85-
+ PARTAS_RENDER_VARIANT
86-
)
87-
88-
ignore PARTAS_VARIANT_RENDER
84+
fun PARTAS_RENDER_BUILDER ->
85+
ignore (
86+
"PARTAS_RENDER_VARIANT"
87+
+ PARTAS_RENDER_VARIANT
88+
)
89+
PARTAS_RENDER_BUILDER |> PARTAS_VARIANT_RENDER
90+
|> ignore
91+
PARTAS_FIRST PARTAS_BUILDER
92+
[<CustomOperation "decorator">]
93+
member inline _.Decorator([<InlineIfLambda>] PARTAS_FIRST: StorybookFun<'T>, [<InlineIfLambda>] PARTAS_DECORATOR: (unit -> 'T) -> Partas.Solid.Builder.HtmlElement) =
94+
fun PARTAS_BUILDER ->
95+
ignore PARTAS_DECORATOR
96+
PARTAS_FIRST PARTAS_BUILDER
97+
[<CustomOperation "decorator">]
98+
member inline _.Decorator([<InlineIfLambda>] PARTAS_FIRST: StorybookFun<'T>, PARTAS_DECORATOR_VARIANT: string, [<InlineIfLambda>] PARTAS_VARIANT_DECORATOR: (unit -> 'T) -> Partas.Solid.Builder.HtmlElement) =
99+
fun PARTAS_BUILDER ->
100+
fun PARTAS_DECORATOR_BUILDER ->
101+
ignore (
102+
"PARTAS_DECORATOR_VARIANT"
103+
+ PARTAS_DECORATOR_VARIANT
104+
)
105+
PARTAS_VARIANT_DECORATOR PARTAS_DECORATOR_BUILDER
106+
|> ignore
89107
PARTAS_FIRST PARTAS_BUILDER
90108

91109
type StorybookArgs<'T> with

0 commit comments

Comments
 (0)