Fable React JSX Plugin

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