Skip to content

Commit

Permalink
#1266 #1267 : JavaScript attribute for constructor parameter, remove …
Browse files Browse the repository at this point in the history 
…InlineControl.Create and use constructor instead
  • Loading branch information
@Jooseppi12
Jooseppi12 committed Oct 3, 2022
1 parent 18d2511 commit 68b75cf
Show file tree
Hide file tree
Showing 7 changed files with 106 additions and 23 deletions.
59 changes: 59 additions & 0 deletions src/compiler/WebSharper.Compiler.FSharp/CodeReader.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1310,6 +1310,65 @@ let scanExpression (env: Environment) (containingMethodName: string) (expr: FSha
)
| _ -> default'()
| _ -> default'()
| P.NewObject(meth, typeList, arguments) ->
let typ = env.SymbolReader.ReadTypeDefinition(getDeclaringEntity meth)
match env.SymbolReader.ReadMember(meth) with
| Member.Constructor(con) ->
match env.Compilation.TryLookupQuotedConstArgMethod(typ, con) with
| Some x ->
arguments |> List.iteri (fun i a ->
if x |> 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 qm =
Hashed {
MethodInfo.Generics = 0
MethodInfo.MethodName = sprintf "%s$%i$%i" containingMethodName (fst pos.Start) (snd pos.Start)
MethodInfo.Parameters = con.Value.CtorParameters
MethodInfo.ReturnType = Type.VoidType
}
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
)
| _ -> default'()
| _ -> default'()
| _ -> default'()
with _ ->
// some TP-s can create code that FCS fails to expose, ignore that
Expand Down
3 changes: 2 additions & 1 deletion src/compiler/WebSharper.Compiler.FSharp/ProjectReader.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 con -> comp.AddQuotedConstArgMethod(thisDef, con.Value, 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
Expand Down
29 changes: 29 additions & 0 deletions src/compiler/WebSharper.Compiler/Compilation.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -452,6 +452,17 @@ type Compilation(meta: Info, ?hasGraph) =
member this.AddQuotedArgMethod(typ, m, a) =
compilingQuotedArgMethods.Add((typ, m), a)

member this.AddQuotedConstArgMethod(typ: TypeDefinition, c: ConstructorInfo, a) =
// add .ctor
let methodInfo : MethodInfo =
{
MethodName = typ.Value.AssemblyQualifiedName + ".ctor"
Parameters = c.CtorParameters
ReturnType = Type.VoidType
Generics = 0
}
compilingQuotedArgMethods.Add((typ, Hashed methodInfo), a)

member this.TryLookupQuotedArgMethod(typ, m) =
match compilingQuotedArgMethods.TryFind(typ, m) with
| Some x -> Some x
Expand All @@ -463,6 +474,24 @@ type Compilation(meta: Info, ?hasGraph) =
| None -> None
| None -> None

member this.TryLookupQuotedConstArgMethod(typ: TypeDefinition, (con: Constructor)) =
let methodInfo : Method =
Hashed {
MethodName = typ.Value.AssemblyQualifiedName + ".ctor"
Parameters = con.Value.CtorParameters
ReturnType = Type.VoidType
Generics = 0
}
match compilingQuotedArgMethods.TryFind(typ, methodInfo) with
| Some x -> Some x
| None ->
match meta.Classes.TryFind(typ) with
| Some c ->
match c.QuotedArgMethods.TryFind(methodInfo) with
| Some x -> Some x
| None -> None
| None -> None

member this.AddClass(typ, cls) =
try
notResolvedClasses.Add(typ, cls)
Expand Down
12 changes: 3 additions & 9 deletions src/sitelets/WebSharper.Web/Control.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -281,7 +281,7 @@ open ClientSideInternals
/// 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.
[<CompiledName "FSharpInlineControl">]
type InlineControl<'T when 'T :> IControlBody>(elt: Expr<'T>) =
type InlineControl<'T when 'T :> IControlBody>([<JavaScript; ReflectedDefinition>] elt: Expr<'T>) =
inherit Control()

[<System.NonSerialized>]
Expand Down Expand Up @@ -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> ([<JavaScript; ReflectedDefinition>] e: Expr<'T>) =
new InlineControl<'T>(e)

open System
open System.Reflection
open System.Linq.Expressions
Expand Down Expand Up @@ -441,6 +435,6 @@ module WebExtensions =
open Microsoft.FSharp.Quotations
open WebSharper.Web

[<System.Obsolete "Use `WebSharper.Web.InlineControl.Create` instead">]
[<System.Obsolete "Use `new WebSharper.Web.InlineControl(e)` instead">]
let ClientSide ([<JavaScript; ReflectedDefinition>] e: Expr<#IControlBody>) =
new InlineControl<_>(e)
new InlineControl<_>(%e)
6 changes: 3 additions & 3 deletions tests/WebSharper.Sitelets.Tests/SampleSite.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 () ) :> _
]
)
}
Expand Down Expand Up @@ -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"|]
Expand Down
4 changes: 2 additions & 2 deletions tests/WebSharper.StaticHtml.Tests.NetStandard/Main.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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"|]
Expand Down
16 changes: 8 additions & 8 deletions tests/Website/Content.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -95,16 +95,16 @@ let TestsPage runServerTests autoStart (ctx: Context<FullAction>) =
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<Web.Control>
)
)
Expand Down

0 comments on commit 68b75cf

Please sign in to comment.