diff --git a/src/compiler/WebSharper.Compiler.FSharp/CodeReader.fs b/src/compiler/WebSharper.Compiler.FSharp/CodeReader.fs index 85d5487b..74676ead 100644 --- a/src/compiler/WebSharper.Compiler.FSharp/CodeReader.fs +++ b/src/compiler/WebSharper.Compiler.FSharp/CodeReader.fs @@ -1241,6 +1241,57 @@ let scanExpression (env: Environment) (containingMethodName: string) (expr: FSha let default'() = List.iter scan expr.ImmediateSubExpressions try + let storeExprTranslation (mem: FSharpMemberOrFunctionOrValue) (indexes: int[]) (arguments: FSharpExpr list) = + let pars = mem.CurriedParameterGroups |> Seq.concat |> Array.ofSeq + indexes |> Array.iter (fun i -> + let arg = arguments[i] + let p = pars[i] + let e, withValue = + match arg with + | P.Quote e -> Some e, false + | P.Call(None, wv, _, _, [_; P.Quote e]) + when wv.FullName = "Microsoft.FSharp.Quotations.WithValue" -> Some e, true + | P.Value v -> + match vars.TryGetValue v with + | true, e -> Some e, false + | false, _ -> None, false + | _ -> None, false + let expectWithValue = + pars[i].Attributes |> Seq.exists (fun a -> + a.AttributeType.FullName = "Microsoft.FSharp.Core.ReflectedDefinitionAttribute" + && a.ConstructorArguments |> Seq.exists (fun (_, v) -> v = true) + ) + match e with + | Some e -> + let pos = e.Range.AsSourcePos + if expectWithValue && not withValue then + env.Compilation.AddWarning(Some pos, SourceWarning "Auto-quoted argument expected to have access to server-side value. Use `( )` instead of `<@ @>`.") + let e = transformExpression env e + let argTypes = [ for (v, _, _) in env.FreeVars -> env.SymbolReader.ReadType Map.empty v.FullType ] + let retTy = env.SymbolReader.ReadType Map.empty mem.ReturnParameter.Type + let qm = + Hashed { + MethodInfo.Generics = 0 + MethodInfo.MethodName = sprintf "%s$%i$%i" containingMethodName (fst pos.Start) (snd pos.Start) + MethodInfo.Parameters = argTypes + MethodInfo.ReturnType = retTy + } + let argNames = [ for (v, id, _) in env.FreeVars -> v.LogicalName ] + let f = Lambda([ for (_, id, _) in env.FreeVars -> id ], e) + // emptying FreeVars so that env can be reused for reading multiple quotation arguments + env.FreeVars.Clear() + // if the quotation is a single static call, the runtime fallback will be able to + // handle it without introducing a pre-compiled function for it + let isTrivial = + match e with + | I.Call(None, _, _, args) -> + args |> List.forall (function I.Var _ | I.Value _ -> true | _ -> false) + | _ -> false + if not isTrivial then + quotations.Add(pos, qm, argNames, f) + | None -> scan arg + ) + match expr with | P.Let ((id, (P.Quote value), _), body) -> // I'd rather pass around a Map than do this dictionary mutation, @@ -1253,61 +1304,26 @@ let scanExpression (env: Environment) (containingMethodName: string) (expr: FSha match env.SymbolReader.ReadMember(meth) with | Member.Method(_, m) -> match env.Compilation.TryLookupQuotedArgMethod(typ, m) with - | Some x -> + | Some indexes -> Option.iter scan this arguments |> List.iteri (fun i a -> - if x |> Array.contains i |> not then + if indexes |> Array.contains i |> not then scan a ) - let pars = meth.CurriedParameterGroups |> Seq.concat |> Array.ofSeq - x |> Array.iter (fun i -> - let arg = arguments.[i] - let p = pars[i] - let e, withValue = - match arg with - | P.Quote e -> Some e, false - | P.Call(None, wv, _, _, [_; P.Quote e]) - when wv.FullName = "Microsoft.FSharp.Quotations.WithValue" -> Some e, true - | P.Value v -> - match vars.TryGetValue v with - | true, e -> Some e, false - | false, _ -> None, false - | _ -> None, false - let expectWithValue = - pars[i].Attributes |> Seq.exists (fun a -> - a.AttributeType.FullName = "Microsoft.FSharp.Core.ReflectedDefinitionAttribute" - && a.ConstructorArguments |> Seq.exists (fun (_, v) -> v = true) - ) - match e with - | Some e -> - let pos = e.Range.AsSourcePos - if expectWithValue && not withValue then - env.Compilation.AddWarning(Some pos, SourceWarning "Auto-quoted argument expected to have access to server-side value. Use `( )` instead of `<@ @>`.") - let e = transformExpression env e - let argTypes = [ for (v, _, _) in env.FreeVars -> env.SymbolReader.ReadType Map.empty v.FullType ] - let retTy = env.SymbolReader.ReadType Map.empty meth.ReturnParameter.Type - let qm = - Hashed { - MethodInfo.Generics = 0 - MethodInfo.MethodName = sprintf "%s$%i$%i" containingMethodName (fst pos.Start) (snd pos.Start) - MethodInfo.Parameters = argTypes - MethodInfo.ReturnType = retTy - } - let argNames = [ for (v, id, _) in env.FreeVars -> v.LogicalName ] - let f = Lambda([ for (_, id, _) in env.FreeVars -> id ], e) - // emptying FreeVars so that env can be reused for reading multiple quotation arguments - env.FreeVars.Clear() - // if the quotation is a single static call, the runtime fallback will be able to - // handle it without introducing a pre-compiled function for it - let isTrivial = - match e with - | I.Call(None, _, _, args) -> - args |> List.forall (function I.Var _ | I.Value _ -> true | _ -> false) - | _ -> false - if not isTrivial then - quotations.Add(pos, qm, argNames, f) - | None -> scan arg + storeExprTranslation meth indexes arguments + | _ -> default'() + | _ -> default'() + | P.NewObject(ctor, typeList, arguments) -> + let typ = env.SymbolReader.ReadTypeDefinition(getDeclaringEntity ctor) + match env.SymbolReader.ReadMember(ctor) with + | Member.Constructor(con) -> + match env.Compilation.TryLookupQuotedConstArgMethod(typ, con) with + | Some indexes -> + arguments |> List.iteri (fun i a -> + if indexes |> Array.contains i |> not then + scan a ) + storeExprTranslation ctor indexes arguments | _ -> default'() | _ -> default'() | _ -> default'() diff --git a/src/compiler/WebSharper.Compiler.FSharp/ProjectReader.fs b/src/compiler/WebSharper.Compiler.FSharp/ProjectReader.fs index d66d53e7..651920ef 100644 --- a/src/compiler/WebSharper.Compiler.FSharp/ProjectReader.fs +++ b/src/compiler/WebSharper.Compiler.FSharp/ProjectReader.fs @@ -751,7 +751,8 @@ let rec private transformClass (sc: Lazy<_ * StartupCode>) (comp: Compilation) ( if not (Array.isEmpty jsArgs) then match sr.ReadMember meth with | Member.Method (_, mdef) -> comp.AddQuotedArgMethod(thisDef, mdef, jsArgs) - | _ -> error "JavaScript attribute on parameter is only allowed on methods" + | Member.Constructor cdef -> comp.AddQuotedConstArgMethod(thisDef, cdef, jsArgs) + | _ -> error "JavaScript attribute on parameter is only allowed on methods and constructors" let tparams = meth.GenericParameters |> Seq.map (fun p -> p.Name) |> List.ofSeq let env = CodeReader.Environment.New ([], tparams, comp, sr) CodeReader.scanExpression env meth.LogicalName expr diff --git a/src/compiler/WebSharper.Compiler/Compilation.fs b/src/compiler/WebSharper.Compiler/Compilation.fs index c0d72358..ab25af00 100644 --- a/src/compiler/WebSharper.Compiler/Compilation.fs +++ b/src/compiler/WebSharper.Compiler/Compilation.fs @@ -463,6 +463,20 @@ type Compilation(meta: Info, ?hasGraph) = | None -> None | None -> None + member this.GetFakeMethodForCtor(c: Constructor) = + Method { + MethodName = ".ctor" + Parameters = c.Value.CtorParameters + ReturnType = Type.VoidType + Generics = 0 + } + + member this.AddQuotedConstArgMethod(typ: TypeDefinition, c: Constructor, a) = + compilingQuotedArgMethods.Add((typ, this.GetFakeMethodForCtor(c)), a) + + member this.TryLookupQuotedConstArgMethod(typ: TypeDefinition, c: Constructor) = + this.TryLookupQuotedArgMethod(typ, this.GetFakeMethodForCtor(c)) + member this.AddClass(typ, cls) = try notResolvedClasses.Add(typ, cls) diff --git a/src/sitelets/WebSharper.Web/Control.fs b/src/sitelets/WebSharper.Web/Control.fs index 2fa04fbf..049d2d00 100644 --- a/src/sitelets/WebSharper.Web/Control.fs +++ b/src/sitelets/WebSharper.Web/Control.fs @@ -277,11 +277,11 @@ module ClientSideInternals = open ClientSideInternals -/// Embed the given client-side control body in a server-side control. +/// Embeds the given client-side control body in a server-side control. /// The client-side control body must be an implicit or explicit quotation expression. /// It can capture local variables, of the same types which are serializable by WebSharper as RPC results. [] -type InlineControl<'T when 'T :> IControlBody>(elt: Expr<'T>) = +type InlineControl<'T when 'T :> IControlBody>([] elt: Expr<'T>) = inherit Control() [] @@ -331,12 +331,6 @@ type InlineControl<'T when 'T :> IControlBody>(elt: Expr<'T>) = member this.Encode(meta, json) = [this.ID, json.GetEncoder(this.GetType()).Encode this] - /// Embed the given client-side control body in a server-side control. - /// The client-side control body must be an implicit or explicit quotation expression. - /// It can capture local variables, of the same types which are serializable by WebSharper as RPC results. - static member Create<'T when 'T :> IControlBody> ([] e: Expr<'T>) = - new InlineControl<'T>(e) - open System open System.Reflection open System.Linq.Expressions @@ -441,6 +435,6 @@ module WebExtensions = open Microsoft.FSharp.Quotations open WebSharper.Web - [] + [] let ClientSide ([] e: Expr<#IControlBody>) = - new InlineControl<_>(e) + new InlineControl<_>(%e) diff --git a/tests/WebSharper.Sitelets.Tests/SampleSite.fs b/tests/WebSharper.Sitelets.Tests/SampleSite.fs index a53cba1f..955b826b 100644 --- a/tests/WebSharper.Sitelets.Tests/SampleSite.fs +++ b/tests/WebSharper.Sitelets.Tests/SampleSite.fs @@ -195,7 +195,7 @@ module SampleSite = yield! t.Login yield! t.Menu yield! t.Body - yield Web.InlineControl.Create ( Client.Widget () ) :> _ + yield Web.InlineControl ( Client.Widget () ) :> _ ] ) } @@ -233,13 +233,13 @@ module SampleSite = [ Elt("h1", Text "Welcome to our site!") "Let us know how we can contact you" => ctx.Link Action.Contact - Elt("div", Web.InlineControl.Create (Client.Elt "b" [|Client.Text "It's working baby"|] )) + Elt("div", Web.InlineControl (Client.Elt "b" [|Client.Text "It's working baby"|] )) Elt("div", Text """This should say 'Checking "attribute" encoding':""", Elt("input", Attr("placeholder", """Checking "attribute" encoding""")) ) Elt("div", - Web.InlineControl.Create + Web.InlineControl ( Client.Elt "i" [| Client.Text "On the " Client.Elt "b" [|Client.Text "client side"|] diff --git a/tests/WebSharper.StaticHtml.Tests.NetStandard/Main.fs b/tests/WebSharper.StaticHtml.Tests.NetStandard/Main.fs index 9d274e03..47f53dfb 100644 --- a/tests/WebSharper.StaticHtml.Tests.NetStandard/Main.fs +++ b/tests/WebSharper.StaticHtml.Tests.NetStandard/Main.fs @@ -57,13 +57,13 @@ module Site = Body = [ Elt("h1", Text "Welcome to our site!") "About us" => ctx.Link EndPoint.About - Elt("div", Web.InlineControl.Create ( Client.Elt "b" [|Client.Text "It's working baby"|] )) + Elt("div", Web.InlineControl ( Client.Elt "b" [|Client.Text "It's working baby"|] )) Elt("div", Text """This should say 'Checking "attribute" encoding':""", Elt("input", Attr("placeholder", """Checking "attribute" encoding""")) ) Elt("div", - Web.InlineControl.Create + Web.InlineControl ( Client.Elt "i" [| Client.Text "On the " Client.Elt "b" [|Client.Text "client side"|] diff --git a/tests/Website/Content.fs b/tests/Website/Content.fs index 6db0a4ac..0d3ab760 100644 --- a/tests/Website/Content.fs +++ b/tests/Website/Content.fs @@ -95,16 +95,16 @@ let TestsPage runServerTests autoStart (ctx: Context) = Title = "WebSharper client-side tests", Body = ( [ - yield Web.InlineControl.Create ( WebSharper.Tests.Main.RunTests runServerTests autoStart ) :> Web.Control - yield Web.InlineControl.Create ( WebSharper.Collections.Tests.Main.RunTests() ) :> Web.Control + yield Web.InlineControl ( WebSharper.Tests.Main.RunTests runServerTests autoStart ) :> Web.Control + yield Web.InlineControl ( WebSharper.Collections.Tests.Main.RunTests() ) :> Web.Control yield WebSharper.CSharp.Tests.InlineControlTest.RunTestsControl runServerTests - yield Web.InlineControl.Create ( Client.ClientSideTupleTest t12 ) :> Web.Control - yield Web.InlineControl.Create ( WebSharper.Html5.Tests.Main.RunTests true ) :> Web.Control - yield Web.InlineControl.Create ( WebSharper.Sitelets.Tests.ClientServerTests.RunTests apiBaseUri corsBaseUri runServerTests ) :> Web.Control + yield Web.InlineControl ( Client.ClientSideTupleTest t12 ) :> Web.Control + yield Web.InlineControl ( WebSharper.Html5.Tests.Main.RunTests true ) :> Web.Control + yield Web.InlineControl ( WebSharper.Sitelets.Tests.ClientServerTests.RunTests apiBaseUri corsBaseUri runServerTests ) :> Web.Control if runServerTests then - yield Web.InlineControl.Create ( WebSharper.Sitelets.Tests.ApiTests.RunTests apiBaseUri ) :> Web.Control - yield Web.InlineControl.Create ( WebSharper.Module.Tests.Main.RunTests() ) :> Web.Control - yield Web.InlineControl.Create ( WebSharperWebTestsMain.RunTests jsonBaseUri runServerTests ) :> Web.Control + yield Web.InlineControl ( WebSharper.Sitelets.Tests.ApiTests.RunTests apiBaseUri ) :> Web.Control + yield Web.InlineControl ( WebSharper.Module.Tests.Main.RunTests() ) :> Web.Control + yield Web.InlineControl ( WebSharperWebTestsMain.RunTests jsonBaseUri runServerTests ) :> Web.Control ] : list ) )