Skip to content

Commit

Permalink
Fix #155: templating: server-side event handler dependency
Browse files Browse the repository at this point in the history
  • Loading branch information
Tarmil committed Feb 21, 2018
1 parent d14537e commit 21104e5
Show file tree
Hide file tree
Showing 8 changed files with 110 additions and 82 deletions.
2 changes: 1 addition & 1 deletion WebSharper.UI.CSharp.Templating/CodeGenerator.fs
Original file line number Diff line number Diff line change
Expand Up @@ -148,7 +148,7 @@ let finalMethodBody (ctx: Ctx) =
|> sprintf "new Tuple<string, WebSharper.UI.Templating.Runtime.Server.ValTy>[] { %s }"
[
sprintf "var completed = WebSharper.UI.Templating.Runtime.Server.Handler.CompleteHoles(key, holes, %s);" vars
sprintf "var doc = WebSharper.UI.Templating.Runtime.Server.Runtime.GetOrLoadTemplate(%s, %s, %s, %s, completed.Item1, %s, ServerLoad.%s, %s, %b);"
sprintf "var doc = WebSharper.UI.Templating.Runtime.Server.Runtime.GetOrLoadTemplate(%s, %s, %s, %s, completed.Item1, %s, ServerLoad.%s, %s, null, %b);"
(formatString ctx.FileId)
(optionValue formatString "string" name)
(optionValue formatString "string" ctx.Path)
Expand Down
102 changes: 58 additions & 44 deletions WebSharper.UI.Templating.Runtime/Runtime.fs
Original file line number Diff line number Diff line change
Expand Up @@ -51,16 +51,21 @@ type ValTy =
[<JavaScript; Serializable>]
type TemplateInitializer(id: string, vars: array<string * ValTy>) =

do if IsClient then
let d = Dictionary()
for n, t in vars do
d.[n] <-
match t with
| ValTy.Bool -> box (Var.Create false)
| ValTy.Number -> box (Var.Create 0.)
| ValTy.String -> box (Var.Create "")
| _ -> failwith "Invalid value type"
TemplateInstances.Instances.[id] <- TemplateInstance(CompletedHoles.Client(d), Doc.Empty)
member this.Instance =
if JavaScript.JS.HasOwnProperty this "instance" then
JavaScript.JS.Get "instance" this : TemplateInstance
else
let d = Dictionary()
for n, t in vars do
d.[n] <-
match t with
| ValTy.Bool -> box (Var.Create false)
| ValTy.Number -> box (Var.Create 0.)
| ValTy.String -> box (Var.Create "")
| _ -> failwith "Invalid value type"
let i = TemplateInstance(CompletedHoles.Client(d), Doc.Empty)
JavaScript.JS.Set this "instance" i
i

// Members unused, but necessary to force `id` and `vars` to be fields
// (and not just ctor arguments)
Expand All @@ -76,24 +81,16 @@ type TemplateInitializer(id: string, vars: array<string * ValTy>) =
[id, json.GetEncoder<TemplateInitializer>().Encode(this)]

and [<JavaScript>] TemplateInstances() =

static let instances = Dictionary<string, TemplateInstance>()

[<JavaScript>]
static member Instances : Dictionary<string, TemplateInstance> = instances
[<JavaScript>]
static member GetInstance key = instances.[key]
static member GetInstance key =
let i = JavaScript.JS.Get key WebSharper.Activator.Instances : TemplateInitializer
i.Instance

and CompletedHoles =
| Client of Dictionary<string, obj>
| Server of TemplateInitializer

and TemplateInstance(c: CompletedHoles, doc: Doc) =
let doc =
let (CompletedHoles.Server i) = c
match doc with
| :? Elt as e -> Server.Internal.TemplateElt([i :> IRequiresResources], e) :> Doc
| doc -> Server.Internal.TemplateDoc([i :> IRequiresResources], doc) :> Doc

member this.Doc = doc

Expand Down Expand Up @@ -168,7 +165,7 @@ type Handler private () =
)
|> Seq.append extraHoles
|> Seq.cache
holes, Server (new TemplateInitializer(key, vars))
holes, Server (new TemplateInitializer(id = key, vars = vars))

type private RenderContext =
{
Expand Down Expand Up @@ -223,6 +220,7 @@ type Runtime private () =
inlineBaseName: option<string>,
serverLoad: ServerLoad,
refs: array<string * option<string> * string>,
completed: CompletedHoles,
isElt: bool
) : Doc =
let getOrLoadSrc src =
Expand All @@ -233,6 +231,16 @@ type Runtime private () =
let src = File.ReadAllText fullPath
let parsed, _, _ = Parsing.ParseSource baseName src
loaded.AddOrUpdate(baseName, parsed, fun _ _ -> parsed)
let requireResources = Dictionary(StringComparer.InvariantCultureIgnoreCase)
fillWith |> Seq.iter (function
| TemplateHole.Elt (n, d) when not (obj.ReferenceEquals(d, null)) ->
requireResources.Add(n, d :> IRequiresResources)
| TemplateHole.Attribute (n, a) when not (obj.ReferenceEquals(a, null)) ->
requireResources.Add(n, a :> IRequiresResources)
| TemplateHole.EventQ (n, _, e) ->
requireResources.Add(n, Attr.HandlerImpl "" e :> IRequiresResources)
| _ -> ()
)

let rec writeWrappedTemplate templateName (template: Template) ctx =
let tagName = template.Value |> Array.tryPick (function
Expand Down Expand Up @@ -272,21 +280,25 @@ type Runtime private () =
| Attr.Attr holeName when plain ->
ctx.Writer.WriteAttribute(AttrAttr, holeName)
| Attr.Attr holeName ->
match ctx.FillWith.TryGetValue holeName with
| true, TemplateHole.Attribute (_, a) -> a.Write(ctx.Context.Metadata, ctx.Writer, true)
| true, _ -> failwithf "Invalid hole, expected attribute: %s" holeName
| false, _ -> ()
match requireResources.TryGetValue holeName with
| true, (:? UI.Attr as a) ->
a.Write(ctx.Context.Metadata, ctx.Writer, true)
| _ ->
if ctx.FillWith.ContainsKey holeName then
failwithf "Invalid hole, expected attribute: %s" holeName
| Attr.Simple(name, value) ->
ctx.Writer.WriteAttribute(name, value)
| Attr.Compound(name, value) ->
ctx.Writer.WriteAttribute(name, unencodedStringParts value)
| Attr.Event(event, holeName) when plain ->
ctx.Writer.WriteAttribute(EventAttrPrefix + event, holeName)
| Attr.Event(event, holeName) ->
match ctx.FillWith.TryGetValue holeName with
| true, TemplateHole.EventQ (_, _, e) -> (Attr.HandlerImpl event e).Write(ctx.Context.Metadata, ctx.Writer, true)
| true, _ -> failwithf "Invalid hole, expected quoted event: %s" holeName
| false, _ -> ()
match requireResources.TryGetValue holeName with
| true, (:? UI.Attr as a) ->
a.WithName("on" + event).Write(ctx.Context.Metadata, ctx.Writer, true)
| _ ->
if ctx.FillWith.ContainsKey holeName then
failwithf "Invalid hole, expected quoted event: %s" holeName
| Attr.OnAfterRender holeName ->
if plain then ctx.Writer.WriteAttribute(AfterRenderAttr, holeName)
let rec writeElement tag attrs dataVar children =
Expand Down Expand Up @@ -327,11 +339,14 @@ type Runtime private () =
| Node.DocHole ("scripts" | "styles" | "meta" as name) when Option.isSome ctx.Resources ->
ctx.Writer.Write(ctx.Resources.Value.[name])
| Node.DocHole holeName ->
match ctx.FillWith.TryGetValue holeName with
| true, TemplateHole.Elt (_, doc) -> doc.Write(ctx.Context, ctx.Writer, ctx.Resources)
| true, TemplateHole.Text (_, txt) -> ctx.Writer.WriteEncodedText(txt)
| true, _ -> failwithf "Invalid hole, expected Doc: %s" holeName
| false, _ -> ()
match requireResources.TryGetValue holeName with
| true, (:? UI.Doc as doc) ->
doc.Write(ctx.Context, ctx.Writer, ctx.Resources)
| _ ->
match ctx.FillWith.TryGetValue holeName with
| true, TemplateHole.Text (_, txt) -> ctx.Writer.WriteEncodedText(txt)
| true, _ -> failwithf "Invalid hole, expected Doc: %s" holeName
| false, _ -> ()
| Node.Instantiate _ ->
failwithf "Template instantiation not yet supported on the server side"
Array.iter writeNode template.Value
Expand Down Expand Up @@ -368,15 +383,14 @@ type Runtime private () =
| Some _, _ -> failwith "Invalid ServerLoad"
templates := Some t
getTemplate baseName (Parsing.WrappedTemplateName.OfOption name) t, t
let requireResources =
fillWith
|> Seq.choose (function
| TemplateHole.Elt (_, d) when not (obj.ReferenceEquals(d, null)) ->
Some (d :> IRequiresResources)
| TemplateHole.Attribute (_, a) when not (obj.ReferenceEquals(a, null)) ->
Some (a :> IRequiresResources)
| _ -> None
)
let tplInstance =
if obj.ReferenceEquals(completed, null) then
Seq.empty
else
match completed with
| CompletedHoles.Server i -> Seq.singleton (i :> IRequiresResources)
| CompletedHoles.Client _ -> failwith "Shouldn't happen"
let requireResources = Seq.append tplInstance requireResources.Values
let write extraAttrs ctx w r =
let template, templates = getTemplates ctx
let r =
Expand Down
3 changes: 2 additions & 1 deletion WebSharper.UI.Templating.Runtime/RuntimeClient.fs
Original file line number Diff line number Diff line change
Expand Up @@ -186,7 +186,7 @@ type GetOrLoadTemplateMacro() =
comp.AddMetadataEntry(meKey, M.CompositeEntry [ M.TypeDefinitionEntry td; M.MethodEntry m ])
td, m
match call.Arguments with
| [ baseName; name; path; src; fillWith; inlineBaseName; serverLoad; refs; isElt ] ->
| [ baseName; name; path; src; fillWith; inlineBaseName; serverLoad; refs; completedHoles; isElt ] ->
let inlineBaseName =
match ExtractOption inlineBaseName with
| Some (I.Value (String n)) -> Some n
Expand Down Expand Up @@ -215,6 +215,7 @@ type private RuntimeProxy =
inlineBaseName: option<string>,
serverLoad: ServerLoad,
refs: array<string * option<string> * string>,
completed: Server.CompletedHoles,
isElt: bool
) : Doc =
X<Doc>
Expand Down
39 changes: 23 additions & 16 deletions WebSharper.UI.Templating.ServerSide.Tests/Main.fs
Original file line number Diff line number Diff line change
Expand Up @@ -32,21 +32,28 @@ module Client =
[<Website>]
let Main = Application.SinglePage(fun ctx ->
Content.Page(
Body = [
MainTemplate.Main()
.Main(MainTemplate.template().Who("world").Doc())
.Client(
[
client <@ Client.Main("green") @>
client <@ Client.Main("blue") @>
client <@ Client.OldMain("old template") @>
MainTemplate.Main.ServerTemplate().Elt()
.OnClick(<@ Client.OnClick @>)
:> Doc
button [on.click(fun _ _ -> JavaScript.JS.Alert "hey!")] [text "Click me!"] :> _
])
.TBody([MainTemplate.Main.Row().Doc(); MainTemplate.Main.Row().Doc()])
.Doc()
]
MainTemplate.Main()
.Main([
MainTemplate.template()
.Who("world 1")
.Click(fun _ -> JavaScript.JS.Alert "Clicked 1!")
.Doc()
MainTemplate.template()
.Who("world 2")
.Click(fun _ -> JavaScript.JS.Alert "Clicked 2!")
.Doc()
])
.Client(
[
client <@ Client.Main("green") @>
client <@ Client.Main("blue") @>
client <@ Client.OldMain("old template") @>
MainTemplate.Main.ServerTemplate().Elt()
.OnClick(<@ Client.OnClick @>)
:> Doc
button [on.click(fun _ _ -> JavaScript.JS.Alert "hey!")] [text "Click me!"] :> _
])
.TBody([MainTemplate.Main.Row().Doc(); MainTemplate.Main.Row().Doc()])
.Doc()
)
)
2 changes: 1 addition & 1 deletion WebSharper.UI.Templating.ServerSide.Tests/template.html
Original file line number Diff line number Diff line change
@@ -1 +1 @@
<b>Hello ${Who}!</b>
<button ws-onclick="Click">Hello ${Who}!</button>
1 change: 1 addition & 0 deletions WebSharper.UI.Templating/TemplatingProvider.fs
Original file line number Diff line number Diff line change
Expand Up @@ -257,6 +257,7 @@ module private Impl =
%OptionValue ctx.InlineFileId,
%%Expr.Value ctx.ServerLoad,
%%references,
completed,
%%Expr.Value ctx.Template.IsElt
)
rTI := TI(completed, doc)
Expand Down
41 changes: 22 additions & 19 deletions WebSharper.UI/Attr.fs
Original file line number Diff line number Diff line change
Expand Up @@ -51,36 +51,32 @@ module private Internal =
}
)

let compile (meta: M.Info) (json: J.Provider) (reqs: list<M.Node>) (q: Expr) =
let rec compile (reqs: list<M.Node>) (q: Expr) =
let compile (meta: M.Info) (json: J.Provider) (q: Expr) =
let reqs = ResizeArray<M.Node>()
let rec compile' (q: Expr) =
match getLocation q with
| Some p ->
match meta.Quotations.TryGetValue(p) with
| false, _ ->
let ex =
meta.Quotations.Keys
|> Seq.map (sprintf " %O")
|> String.concat "\n"
None
| true, (declType, meth, argNames) ->
match meta.Classes.TryGetValue declType with
| false, _ -> failwithf "Error in Handler: Couldn't find JavaScript address for method %s.%s" declType.Value.FullName meth.Value.MethodName
| true, c ->
let argIndices = Map (argNames |> List.mapi (fun i x -> x, i))
let args = Array.create argNames.Length null
let reqs = ref (M.MethodNode (declType, meth) :: M.TypeNode declType :: reqs)
reqs.Add(M.MethodNode (declType, meth))
reqs.Add(M.TypeNode declType)
let setArg (name: string) (value: obj) =
let i = argIndices.[name]
if isNull args.[i] then
args.[i] <-
match value with
| :? Expr as q ->
let x, reqs' = compile !reqs q |> Option.get
reqs := reqs'
x
compile' q |> Option.get
| value ->
let typ = value.GetType()
reqs := M.TypeNode (WebSharper.Core.AST.Reflection.ReadTypeDefinition typ) :: !reqs
reqs.Add(M.TypeNode (WebSharper.Core.AST.Reflection.ReadTypeDefinition typ))
let packed = json.GetEncoder(typ).Encode(value) |> json.Pack
let s =
WebSharper.Core.Json.Stringify(packed)
Expand All @@ -97,11 +93,12 @@ module private Internal =
| _ -> failwithf "Error in Handler: Couldn't find JavaScript address for method %s.%s" declType.Value.FullName meth.Value.MethodName
let funcall = String.concat "." (List.rev addr)
let args = String.concat "," args
Some (sprintf "%s(%s)" funcall args, !reqs)
Some (sprintf "%s(%s)" funcall args)
| None -> None
compile reqs q
|> Option.map (fun (s, reqs) ->
s + "(this)(event)", activateNode :: reqs
compile' q
|> Option.map (fun s ->
reqs.Add(activateNode)
s + "(this)(event)", reqs :> seq<_>
)

// We would have wanted to use UseNullAsTrueValue so that EmptyAttr = null,
Expand Down Expand Up @@ -140,6 +137,12 @@ type Attr =
member this.Encode (meta, json) =
[]

member this.WithName(n) =
match this with
| AppendAttr _ -> this
| SingleAttr(_, v) -> SingleAttr(n, v)
| DepAttr(_, v, d) -> DepAttr(n, v, d)

static member Create name value =
SingleAttr (name, value)

Expand All @@ -161,7 +164,7 @@ type Attr =
let init meta =
if Option.isNone !value then
value :=
match Internal.compile meta json [] q with
match Internal.compile meta json q with
| Some _ as v -> v
| _ ->
let m =
Expand All @@ -176,7 +179,7 @@ type Attr =
fst (Option.get !value)
let getReqs (meta: M.Info) =
init meta
snd (Option.get !value) :> seq<_>
snd (Option.get !value)
Attr.WithDependencies("on" + event, getValue, getReqs)

static member Handler (event: string) ([<JavaScript>] q: Expr<Dom.Element -> #Dom.Event -> unit>) =
Expand All @@ -185,7 +188,7 @@ type Attr =
static member HandlerFallback(m, location) =
let meth = R.ReadMethod m
let declType = R.ReadTypeDefinition m.DeclaringType
let reqs = [M.MethodNode (declType, meth); M.TypeNode declType]
let reqs = [M.MethodNode (declType, meth); M.TypeNode declType] :> seq<_>
let value = ref None
let fail() =
failwithf "Error in Handler%s: Couldn't find JavaScript address for method %s.%s"
Expand All @@ -208,7 +211,7 @@ type Attr =

static member HandlerLinqImpl(event, m, location) =
let func, reqs = Attr.HandlerFallback(m, location)
DepAttr ("on" + event, func, fun _ -> reqs :> _)
DepAttr ("on" + event, func, fun _ -> reqs)

static member HandlerLinq (event: string) (q: Expression<Action<Dom.Element, #Dom.Event>>) =
let meth =
Expand Down
2 changes: 2 additions & 0 deletions WebSharper.UI/Attr.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -35,6 +35,8 @@ type Attr =

member Write : M.Info * System.Web.UI.HtmlTextWriter * bool -> unit

member WithName : string -> Attr

/// Sets a basic DOM attribute, such as `id` to a text value.
static member Create : name: string -> value: string -> Attr

Expand Down

0 comments on commit 21104e5

Please sign in to comment.