Sitelet multi bundle

build.fsx

@@ -45,7 +45,7 @@ open Fake.JavaScript
 open WebSharper.Fake
 
 let version = "7.0"
-let pre = Some "beta4"
+let pre = Some "beta5"
 
 let baseVersion =
     version + match pre with None -> "" | Some x -> "-" + x

src/compiler/WebSharper.Compiler.CSharp/CodeReader.fs

@@ -2759,6 +2759,19 @@ type RoslynTransformer(env: Environment) =
 
 open System.Linq
 
+let rec private isWebControlType (sr: SymbolReader) (c: INamedTypeSymbol) =
+    let typ = sr.ReadNamedTypeDefinition c
+    match typ.Value.FullName with
+    | "WebSharper.Web.FSharpInlineControl"
+    | "WebSharper.Web.InlineControl" ->
+        false
+    | _ ->
+        match c.BaseType with
+        | null -> false
+        | bCls ->
+            let bTyp = sr.ReadNamedTypeDefinition bCls
+            bTyp.Value.FullName = "WebSharper.Web.Control" || isWebControlType sr bCls
+
 // Searches for calls within server-side code to method with JavaScript-enabled parameters.
 let scanExpression (env: Environment) (node: SyntaxNode) =
 
@@ -2791,30 +2804,30 @@ let scanExpression (env: Environment) (node: SyntaxNode) =
                             let esymbol = env.SemanticModel.GetSymbolInfo(e).Symbol :?> IMethodSymbol
                             if not (isNull esymbol) then
                                 let etyp, emeth = getTypeAndMethod esymbol
-                                env.Compilation.AddQuotedMethod(etyp, emeth)
+                                env.Compilation.AddQuotedMethod(etyp, emeth, [])
                             let pos = getSourcePos e
                             let argTypes = esymbol.Parameters |> Seq.map (fun p -> env.SymbolReader.ReadType p.Type)
                             for t in argTypes do
                                 if t.CanHaveDeserializer then
-                                    env.Compilation.TypesNeedingDeserialization.Add(t, pos)
+                                    env.Compilation.AddTypeNeedingDeserialization(t, pos, [])
                         | :? IdentifierNameSyntax as e ->
                             let esymbol = env.SemanticModel.GetSymbolInfo(e).Symbol :?> IPropertySymbol
                             if not (isNull esymbol) then
                                 let etyp, emeth = getTypeAndMethod esymbol.GetMethod
-                                env.Compilation.AddQuotedMethod(etyp, emeth)
+                                env.Compilation.AddQuotedMethod(etyp, emeth, [])
                         | e -> 
                             failwithf "Unexpected form in Client-side LINQ lambda body: %s" (e.ToString())
 
                     | :? MemberAccessExpressionSyntax as e ->
                         let esymbol = env.SemanticModel.GetSymbolInfo(e).Symbol :?> IMethodSymbol
                         if not (isNull esymbol) then
                             let etyp, emeth = getTypeAndMethod esymbol
-                            env.Compilation.AddQuotedMethod(etyp, emeth)
+                            env.Compilation.AddQuotedMethod(etyp, emeth, [])
                         let pos = getSourcePos e
                         let argTypes = esymbol.Parameters |> Seq.map (fun p -> env.SymbolReader.ReadType p.Type)
                         for t in argTypes do
                             if t.CanHaveDeserializer then
-                                env.Compilation.TypesNeedingDeserialization.Add(t, pos)
+                                env.Compilation.AddTypeNeedingDeserialization(t, pos, [])
 
                     | e -> failwithf "Unexpected form in Client-side LINQ expression: %s" (e.ToString())
             )
@@ -2835,11 +2848,16 @@ let scanExpression (env: Environment) (node: SyntaxNode) =
             let symbol = env.SemanticModel.GetSymbolInfo(n).Symbol :?> IMethodSymbol
 
             if not (isNull symbol) then
-                let typ = env.SymbolReader.ReadNamedTypeDefinition symbol.ContainingType
-                let ctor = env.SymbolReader.ReadConstructor symbol
-                //failwithf "Found ObjectCreationExpression: %s" typ.Value.FullName
-                match env.Compilation.TryLookupQuotedConstArgMethod(typ, ctor) with
-                | Some indexes ->
-                    checkQuotedArgs indexes n.ArgumentList
-                | _ -> ()        
+                if isWebControlType env.SymbolReader symbol.ContainingType then
+                    let typ = env.SymbolReader.ReadType symbol.ContainingType
+                    let pos = getSourcePos n
+                    env.Compilation.AddWebControl(typ, pos, []) // TODO C# bundles
+                else
+                    let typ = env.SymbolReader.ReadNamedTypeDefinition symbol.ContainingType
+                    let ctor = env.SymbolReader.ReadConstructor symbol
+                    //failwithf "Found ObjectCreationExpression: %s" typ.Value.FullName
+                    match env.Compilation.TryLookupQuotedConstArgMethod(typ, ctor) with
+                    | Some indexes ->
+                        checkQuotedArgs indexes n.ArgumentList
+                    | _ -> ()        
         | _ -> ()

src/compiler/WebSharper.Compiler.CSharp/ProjectReader.fs

@@ -235,13 +235,6 @@ let rec private isIRequiresResources (sr: R.SymbolReader) (c: INamedTypeSymbol)
         i.Name = "IRequiresResources"
     )
 
-let rec private isWebControlType (sr: R.SymbolReader) (c: INamedTypeSymbol) =
-    match c.BaseType with
-    | null -> false
-    | bCls ->
-        let typ = sr.ReadNamedTypeDefinition bCls
-        typ.Value.FullName = "WebSharper.Web.Control" || isWebControlType sr bCls
-
 let delegateTy, delRemove =
     match <@ System.Delegate.Remove(null, null) @> with
     | FSharp.Quotations.Patterns.Call (_, mi, _) ->
@@ -1387,11 +1380,6 @@ let private transformClass (rcomp: CSharpCompilation) (sr: R.SymbolReader) (comp
 
     if not annot.IsJavaScript && clsMembers.Count = 0 && annot.Macros.IsEmpty then None else
 
-    if not cls.IsAbstract && not isInterface && isWebControlType sr cls then
-        let sourcePos =
-            CodeReader.getSourcePosOfSyntaxReference cls.DeclaringSyntaxReferences[0]
-        comp.TypesNeedingDeserialization.Add(NonGenericType def, sourcePos) |> ignore
-
     if isStruct then
         comp.AddCustomType(def, StructInfo)
 

src/compiler/WebSharper.Compiler.FSharp/CodeReader.fs

@@ -1318,21 +1318,70 @@ type FSharp.Compiler.Text.Range with
             End = this.EndLine, this.EndColumn
         }
 
+let contentModule =
+    TypeDefinition {
+        Assembly = "WebSharper.Sitelets"
+        FullName = "WebSharper.Sitelets.ContentModule"
+    }
+
+let contentType =
+    TypeDefinition {
+        Assembly = "WebSharper.Sitelets"
+        FullName = "WebSharper.Sitelets.FSharpContent"
+    }
+
+type Test =
+    static member Opt (?x : string) = x
+
+exception BundleFail of message: string with
+    override this.ToString() = this.message
+
+let getBundleMethod (typ: TypeDefinition, m: Method, arguments: FSharpExpr list) =
+    if typ = contentModule && m.Value.MethodName.StartsWith "Bundle" then
+        match arguments[0] with
+        | P.Const (value, _) ->
+            [ string value ]
+        | a ->
+            raise <| BundleFail $"Content.Bundle argument must be constant string %s{m.Value.MethodName} %A{a}"   
+    elif typ = contentType && m.Value.MethodName.StartsWith "Page" then
+        match arguments |> List.last with
+        | P.NewUnionCase (_, c, [ P.Const (value, _) ]) when c.Name = "Some" ->
+            [ string value ]
+        | P.NewUnionCase (_, c, _) when c.Name = "None" ->
+            []
+        | _ ->
+            raise <| BundleFail "Content.Page Bundle argument must be constant string" 
+    else
+        []
+
+let rec isWebControlType (cls: FSharpEntity) =
+    match cls.TryFullName with
+    | Some "WebSharper.Web.FSharpInlineControl"
+    | Some "WebSharper.Web.InlineControl" ->
+        false
+    | _ ->
+        match cls.BaseType with
+        | Some bCls ->
+            match bCls.TypeDefinition.TryFullName with
+            | Some "WebSharper.Web.Control" -> 
+                true
+            | _ -> 
+                isWebControlType bCls.TypeDefinition
+        | _ -> false
+
 // Searches for calls within server-side code to method with JavaScript-enabled parameters.
 // These quotations or auto-quoted expressions passed are then translated by WebSharper.
 let scanExpression (env: Environment) (containingMethodName: string) (expr: FSharpExpr) =
     let vars = Dictionary<FSharpMemberOrFunctionOrValue, FSharpExpr>()
     let quotations = ResizeArray()
-    let quotedMethods = ResizeArray()
-    let rec scan (expr: FSharpExpr) =
+    let rec scan bundleScope (expr: FSharpExpr) =
         let default'() =
-            List.iter scan expr.ImmediateSubExpressions
+            List.iter (scan bundleScope) 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
@@ -1357,16 +1406,16 @@ let scanExpression (env: Environment) (containingMethodName: string) (expr: FSha
                         let argTypes = [ for (v, _, _) in env.FreeVars -> env.SymbolReader.ReadType Map.empty v.FullType ]
                         for t in argTypes do
                             if t.CanHaveDeserializer then
-                                env.Compilation.TypesNeedingDeserialization.Add(t, pos)
+                                env.Compilation.AddTypeNeedingDeserialization(t, pos, bundleScope)
                         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
+                            Method {
+                                Generics = 0
+                                MethodName = sprintf "%s$%i$%i" containingMethodName (fst pos.Start) (snd pos.Start)
+                                Parameters = argTypes
+                                ReturnType = retTy
                             }
-                        let argNames = [ for (v, id, _) in env.FreeVars -> v.LogicalName ]
+                        let argNames = [ for (v, _, _) in env.FreeVars -> v.LogicalName ]
                         let f = Lambda([ for (_, id, _) in env.FreeVars -> id ], None, e)
                         // emptying FreeVars so that env can be reused for reading multiple quotation arguments
                         env.FreeVars.Clear()
@@ -1378,53 +1427,69 @@ let scanExpression (env: Environment) (containingMethodName: string) (expr: FSha
                                 args |> List.forall (function I.Var _ | I.Value _ -> true | _ -> false)
                             | _ -> false
                         if not isTrivial then
-                            quotations.Add(pos, qm, argNames, f) 
+                            quotations.Add(pos, qm, argNames, f, bundleScope) 
                         else
                             match e with 
                             | I.Call(None, td, m, _) ->
-                                quotedMethods.Add(td, m) 
+                                env.Compilation.AddQuotedMethod(td.Entity, m.Entity, bundleScope)
                             | _ -> ()
-                    | None -> scan arg
+                    | None -> scan bundleScope arg
                 )
 
             match expr with
             | P.Let ((id, (P.Quote value), _), body) ->
                 // I'd rather pass around a Map than do this dictionary mutation,
                 // but the type FSharpMemberOrFunctionOrValue isn't comparable :(
                 vars.[id] <- value
-                scan body
+                scan bundleScope body
                 vars.Remove(id) |> ignore
             | P.Call(this, meth, typeGenerics, methodGenerics, arguments) ->
                 let typ = env.SymbolReader.ReadTypeDefinition(getDeclaringEntity meth)
                 match env.SymbolReader.ReadMember(meth) with
                 | Member.Method(_, m) ->
                     match env.Compilation.TryLookupQuotedArgMethod(typ, m) with
                     | Some indexes ->
-                        Option.iter scan this
+                        Option.iter (scan bundleScope) this
                         arguments |> List.iteri (fun i a -> 
                             if indexes |> Array.contains i |> not then
-                                scan a
+                                scan bundleScope a
                         )
                         storeExprTranslation meth indexes arguments
-                    | _ -> default'()
+                    | _ -> 
+                        let newBundleScope = getBundleMethod (typ, m, arguments)
+                        List.iter (scan (newBundleScope @ bundleScope)) expr.ImmediateSubExpressions
                 | _ -> default'()
             | P.NewObject(ctor, typeList, arguments) ->
-                let typ = env.SymbolReader.ReadTypeDefinition(getDeclaringEntity ctor)
+                let e = getDeclaringEntity ctor
+                let typ = env.SymbolReader.ReadTypeDefinition(e)
                 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
+                                scan bundleScope a
                         )
                         storeExprTranslation ctor indexes arguments
-                    | _ -> default'()
+                    | _ -> 
+                        if isWebControlType e then
+                            let typArgs = typeList |> List.map (env.SymbolReader.ReadType env.TParams)
+                            let pos = expr.Range.AsSourcePos
+                            env.Compilation.AddWebControl(GenericType typ typArgs, pos, bundleScope)
+                            default'()    
+                        else
+                            default'()
                 | _ -> default'()
             | _ -> default'()
-        with _ -> 
+        with 
+        | BundleFail _ ->
+            reraise()
+        | _ -> 
             // some TP-s can create code that FCS fails to expose, ignore that
             // see https://github.com/dotnet-websharper/core/issues/904
             ()
-    scan expr
-    quotations :> _ seq, quotedMethods :> _ seq
+    try
+        scan [] expr
+    with BundleFail m ->
+        failwith m
+    quotations :> _ seq

src/compiler/WebSharper.Compiler.FSharp/ProjectReader.fs

@@ -179,13 +179,6 @@ let private isIRequiresResources (sr: CodeReader.SymbolReader) (cls: FSharpEntit
         i.BasicQualifiedName = "WebSharper.IRequiresResources"
     )
 
-let rec private isWebControlType (sr: CodeReader.SymbolReader) (cls: FSharpEntity) =
-    match cls.BaseType with
-    | Some bCls ->
-        let typ = sr.ReadTypeDefinition bCls.TypeDefinition
-        typ.Value.FullName = "WebSharper.Web.Control" || isWebControlType sr bCls.TypeDefinition
-    | _ -> false
-
 let isAugmentedFSharpType (e: FSharpEntity) =
     e.IsFSharpRecord || e.IsFSharpExceptionDeclaration || (
         e.IsFSharpUnion 
@@ -965,28 +958,24 @@ let rec private transformClass (sc: Lazy<_ * StartupCode>) (comp: Compilation) (
                     | Member.Implementation (t, mdef) ->    
                         addMethod (Some (meth, memdef)) mAnnot mdef (N.MissingImplementation t) true None Undefined
                     | _ -> ()
-                let jsArgs =
-                    meth.CurriedParameterGroups
-                    |> Seq.concat
-                    |> Seq.mapi (fun i p -> i, sr.AttributeReader.GetParamAnnot(p.Attributes).ClientAccess)
-                    |> Seq.choose (fun (i, x) -> if x then Some i else None)
-                    |> Array.ofSeq
-                if not (Array.isEmpty jsArgs) then
-                    match sr.ReadMember(meth, cls) with
-                    | Member.Method (_, mdef) -> comp.AddQuotedArgMethod(thisDef, mdef, jsArgs)
-                    | 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 ([], false, tparams, comp, sr, recMembers)
-                let quotations, quotedMethods = CodeReader.scanExpression env meth.LogicalName expr
-                quotations
-                |> Seq.iter (fun (pos, mdef, argNames, e) ->
-                    addMethod None A.MemberAnnotation.BasicJavaScript mdef (N.Quotation(pos, argNames)) false None e 
-                )
-                quotedMethods
-                |> Seq.iter (fun (td, m) ->
-                    comp.AddQuotedMethod(td.Entity, m.Entity)
-                )
+            let jsArgs =
+                meth.CurriedParameterGroups
+                |> Seq.concat
+                |> Seq.mapi (fun i p -> i, sr.AttributeReader.GetParamAnnot(p.Attributes).ClientAccess)
+                |> Seq.choose (fun (i, x) -> if x then Some i else None)
+                |> Array.ofSeq
+            if not (Array.isEmpty jsArgs) then
+                match sr.ReadMember(meth, cls) with
+                | Member.Method (_, mdef) -> comp.AddQuotedArgMethod(thisDef, mdef, jsArgs)
+                | 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 ([], false, tparams, comp, sr, recMembers)
+            let quotations = CodeReader.scanExpression env meth.LogicalName expr
+            quotations
+            |> Seq.iter (fun (pos, mdef, argNames, e, bundleScope) ->
+                addMethod None A.MemberAnnotation.BasicJavaScript mdef (N.Quotation(pos, argNames, bundleScope)) false None e 
+            )
         | SourceEntity (ent, nmembers) ->
             transformClass sc comp ac sr classAnnots isInterface false recMembers ent nmembers |> Option.iter comp.AddClass   
         | SourceInterface i ->
@@ -1078,13 +1067,6 @@ let rec private transformClass (sc: Lazy<_ * StartupCode>) (comp: Compilation) (
 
     let isThisAbstract = isAbstractClass cls
 
-    if not isThisAbstract && not isThisInterface && isWebControlType sr cls then
-        match def.Value.FullName with
-        | "WebSharper.Web.FSharpInlineControl"
-        | "WebSharper.Web.InlineControl" -> ()
-        | _ ->
-            comp.TypesNeedingDeserialization.Add(NonGenericType def, CodeReader.getRange cls.DeclarationLocation)
-
     let ckind = 
         if annot.IsStub || (hasStubMember && not hasNonStubMember)
         then NotResolvedClassKind.Stub