@@ -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
502510module internal rec StorybookRender =
503511 let getRender ( ctx : PluginContext ) ( expr : Expr ) =
@@ -512,60 +520,67 @@ module internal rec StorybookRender =
512520
513521module 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 ]
0 commit comments