Skip to content

Instantly share code, notes, and snippets.

@nojaf

nojaf/Plugin.fs

Created September 18, 2024 13:16
Show Gist options
  • Save nojaf/709390fe904d71293ec101e9ac845c58 to your computer and use it in GitHub Desktop.
Save nojaf/709390fe904d71293ec101e9ac845c58 to your computer and use it in GitHub Desktop.
Download ZIP
Fable React JSX Plugin
Raw
Plugin.fs
namespace React.Plugin
open System
open System.IO
open Fable
open Fable.AST
open Fable.AST.Fable
// Tell Fable to scan for plugins in this assembly
[<assembly : ScanForPlugins>]
do ()
module AST =
/// Captures the absolute location of the source location of Expr.Call.
/// <param name="from">Relative path from the DSL to the component</param>
/// <param name="expr">A potential Call(Import()) expression</param>
let (|ComponentImportPath|_|) (from : string) (expr : Expr) =
match expr with
| Expr.Call (
callee = Expr.Import (
info = {
Kind = ImportKind.MemberImport (MemberRef.MemberRef (declaringEntity = declaringEntity))
})) ->
declaringEntity.SourcePath
|> Option.bind (fun declaringFilePath ->
let declaringFile = FileInfo declaringFilePath
let componentFile =
Path.Combine (declaringFile.DirectoryName, from) |> Path.GetFullPath |> FileInfo
if not componentFile.Exists then
None
else
componentFile.FullName |> Some
)
| _ -> None
/// Collect all expressions from a fixed list.
/// This can later be transformed to an array.
let rec (|StaticList|_|) (expr : Expr) =
match expr with
| Value (NewList (headAndTail = Some (headExpr, StaticList tail)), _) -> Some (headExpr :: tail)
| Value (NewList (headAndTail = None), _) -> Some List.empty
| _ -> None
let rec (|StaticArray|_|) (expr : Expr) =
match expr with
| Value (NewArray (newKind = ArrayValues xs), _) -> Some xs
| _ -> None
type PropInfo = string * Expr
type Props = PropInfo list
let (|MemberRefCompiledName|_|) (memberRef : MemberRef) =
match memberRef with
| MemberRef.MemberRef (info = { CompiledName = compiledName }) -> Some compiledName
| _ -> None
[<return : Struct>]
let (|EmptyString|_|) (s : string) =
if System.String.IsNullOrEmpty s then
ValueSome ()
else
ValueNone
let (|PropsExpr|_|) (expr : Expr) : Props option =
match expr with
| StaticList propExprs
| StaticArray propExprs ->
propExprs
|> List.choose (
function
// A function that has [<Emit "" >]
// We have enough information to transform the call
// and don't actually have any use for the helper function.
| Expr.Emit (
info = {
Macro = propName
CallInfo = { Args = [ valueExpr ] }
}) ->
if String.IsNullOrWhiteSpace propName then
None
else
Some (propName, valueExpr)
| _ -> None
)
|> Some
| _ -> None
[<RequireQualifiedAccess>]
type ChildrenExprType =
| Empty
| SingleElement of Expr
| StaticList of array : Expr
| Other of Expr
member this.IsStatic =
match this with
| StaticList _ -> true
| _ -> false
member this.Expr =
match this with
| Empty -> None
| SingleElement e
| StaticList e
| Other e -> Some e
[<Literal>]
let ChildrenPropName = "children"
let jsxElementType =
Type.DeclaredType (
ref =
{
FullName = "Fable.Core.JSX.Element"
Path = EntityPath.CoreAssemblyName "Fable.Core"
},
genericArgs = []
)
let (|ChildrenProp|_|) expr : PropInfo option =
match expr with
| StaticList []
| StaticArray [] -> Some (ChildrenPropName, Expr.Value (ValueKind.Null Type.Any, None))
| StaticList [ singleElement ]
| StaticArray [ singleElement ] -> Some (ChildrenPropName, singleElement)
| StaticList values
| StaticArray values ->
let expr =
Value (NewArray (ArrayValues values, jsxElementType, ArrayKind.ImmutableArray), None)
Some (ChildrenPropName, expr)
| other -> Some (ChildrenPropName, other)
/// Maps the `fn [ prop1; prop2 ] [ child1; child2 ]` pattern
let (|ReactDSLFunctionCall|_|) (expr : Expr) : PropInfo list option =
match expr with
| Expr.Call (_, info, Type.DeclaredType (ref = { FullName = "Fable.Core.JSX.Element" }), _) ->
match info.Args with
| [ TypeCast (PropsExpr props, _)
TypeCast (ChildrenProp childrenProp,
DeclaredType (genericArgs = [ DeclaredType (ref = { FullName = "Fable.Core.JSX.Element" }) ])) ] ->
Some [ yield! props ; yield childrenProp ]
| [ TypeCast (PropsExpr props, _) ] -> Some props
| _ -> None
| _ -> None
let importJsxCreate =
Expr.Import (
info =
{
Selector = "create"
Path = "@fable-org/fable-library-js/JSX.js"
Kind =
ImportKind.LibraryImport
{
IsInstanceMember = false
IsModuleMember = true
}
},
typ = Type.Any,
range = None
)
let mapJsx (componentType : Expr) (props : Props) (range : SourceLocation option) =
let componentTypeExpr = Expr.TypeCast (expr = componentType, typ = Type.Any)
let propsExpr =
let propXs =
props
|> List.map (fun (name, expr) ->
Expr.Value (
kind =
ValueKind.NewTuple (
values =
[
// property name
Expr.Value (kind = ValueKind.StringConstant name, range = None)
// property value
Expr.TypeCast (expr, Type.Any)
],
isStruct = false
),
range = None
)
)
let listItemType =
Type.Tuple (genericArgs = [ Type.String ; Type.Any ], isStruct = false)
let emptyList =
Expr.Value (kind = ValueKind.NewList (headAndTail = None, typ = listItemType), range = None)
(emptyList, propXs)
||> List.fold (fun acc prop ->
Expr.Value (
kind = ValueKind.NewList (headAndTail = Some (prop, acc), typ = listItemType),
range = None
)
)
Expr.Call (
callee = importJsxCreate,
info =
{
ThisArg = None
Args = [ componentTypeExpr ; propsExpr ]
SignatureArgTypes = []
GenericArgs = []
MemberRef = None
Tags = [ "jsx" ]
},
typ = jsxElementType,
range = range
)
type JSXAttribute(import : string option, from : string option) =
inherit MemberDeclarationPluginAttribute()
new() = JSXAttribute (None, None)
new(import : string, from : string) = JSXAttribute (Some import, Some from)
override _.FableMinimumVersion = "4.0"
override this.Transform (_compiler, _file, decl) = decl
override this.TransformCall (_ph : PluginHelper, mb : MemberFunctionOrValue, expr : Expr) : Expr =
// match expr with
// | Expr.Call (callee = Expr.Import (info = { Selector = "div" })) ->
// let dump = sprintf "%A" expr
// let dumpPath = Path.Combine (__SOURCE_DIRECTORY__, "..", "..", $"dump.txt")
// System.IO.File.WriteAllText (dumpPath, dump)
// | _ -> ()
let componentTypeExpr =
match import, from with
| Some import, Some from ->
// from is meant to be used in a DSL file relative to the Component type that should be imported.
// We want to separate the DSL file from the Component in order for hot-module reload to be able to replace the components.
// However, we need to construct the correct path to the Component from the calling side.
let path, kind =
if not (from.EndsWith ".fs") then
from, ImportKind.LibraryImport (LibraryImportInfo.Create (isModuleMember = true))
else
match expr with
| AST.ComponentImportPath from kind -> kind, ImportKind.UserImport true
| _ -> from, ImportKind.UserImport false
Expr.Import (
{
Selector = import
Path = path
Kind = kind
},
Type.Any,
None
)
| _ -> Expr.Value (ValueKind.StringConstant mb.DisplayName, None)
match expr with
| AST.ReactDSLFunctionCall reactDSLInvocation -> AST.mapJsx componentTypeExpr reactDSLInvocation expr.Range
| _ ->
let path =
expr.Range
|> Option.bind (fun sl ->
sl.File
|> Option.map (fun f ->
$" %s{f} (%i{sl.start.line},%i{sl.start.column} %i{sl.``end``.line} %i{sl.``end``.column})"
)
)
|> Option.defaultValue ""
failwithf "Could not transform: %A%s" expr path
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment