Skip to content

Commit

Permalink
#1266 #1267 JavaScript attribute for constructor parameter
Browse files Browse the repository at this point in the history 
remove InlineControl.Create and use constructor instead
  • Loading branch information
@Jooseppi12
Jooseppi12 committed Oct 3, 2022
1 parent 18d2511 commit bf9ee13
Show file tree
Hide file tree
Showing 7 changed files with 99 additions and 74 deletions.
116 changes: 66 additions & 50 deletions src/compiler/WebSharper.Compiler.FSharp/CodeReader.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand All @@ -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'()
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 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
Expand Down
14 changes: 14 additions & 0 deletions src/compiler/WebSharper.Compiler/Compilation.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
14 changes: 4 additions & 10 deletions src/sitelets/WebSharper.Web/Control.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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.
[<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 bf9ee13

Please sign in to comment.