I have a WebSharper website, and I want it to have a different UI when on a mobile device. I would like the server to respond with different HTML depending on if the user is on a mobile device or not. I can see how to check if the user is on a mobile device in ASP.NET but I can't tell how to port this over to WebSharper.
The Context object in WebSharper has an Environment dictionary which contains the original context. You can reach Request.Browser.IsMobileDevice through that. Using the UI.Next Client-Server template you could do somethng like this:
module Site
open WebSharper
open WebSharper.Sitelets
open WebSharper.UI.Next
open WebSharper.UI.Next.Server
type EndPoint =
| [<EndPoint "/">] Home
open WebSharper.UI.Next.Html
type Page = { Desktop: Doc; Mobile: Doc }
let mkPage desktop mobile = { Desktop = desktop; Mobile = mobile }
let HomePage =
mkPage
<| h1 [text "Desktop page!"]
<| h1 [text "Mobile page!"]
let PickPage (ctx : Context<_>) page =
let context = ctx.Environment.["HttpContext"] :?> System.Web.HttpContextWrapper
if context.Request.Browser.IsMobileDevice then page.Mobile
else page.Desktop
|> Content.Page
[<Website>]
let Main =
Application.MultiPage (fun ctx endpoint ->
match endpoint with
| EndPoint.Home -> PickPage ctx HomePage
)
Related
I am new to Bolero. I need two separate layouts both with a separate menu system - one for "normal" web pages, the other for a CMS. That means using two different css files.
Is it possible to have two Elmish loops to achieve that? If not, what then? I have tried to utilise two Elmish loops, but the CMS loop does not work. Visual Studio signals no error, but the CMS page gets me back to the base as if there was something wrong with the routing (which certainly is).
See below for parts of my code, but you will probably need much more - the complete code is available on my GitHub - the CMS system is only simulated there, it is to be coded later.
member this.Configure(app: IApplicationBuilder, env: IWebHostEnvironment) =
app
.UseAuthentication()
.UseRemoting()
.MapWhen(
(fun ctx -> ctx.Request.Path.Value.StartsWith "/rozcestnikCMS"),
(fun app ->
app
.UseBlazorFrameworkFiles()
.UseStaticFiles()
.UseRouting()
.UseEndpoints(fun endpoints ->
endpoints.MapBlazorHub() |> ignore
endpoints.MapFallbackToBolero(IndexCMS.page) |> ignore)
|> ignore
)
)
.UseBlazorFrameworkFiles()
.UseStaticFiles()
.UseRouting()
.UseEndpoints(fun endpoints ->
endpoints.MapBlazorHub() |> ignore
endpoints.MapFallbackToBolero(Index.page) |> ignore)
|> ignore
Index.page
let page = doctypeHtml {
head {
//some code
}
body {
div { attr.id "generalLayout"; rootComp<Client.Controller.MyApp> }
boleroScript
}
}
IndexCMS.page
let page = doctypeHtml {
head {
//some code
}
body {
div { attr.id "generalLayout"; rootComp<Client.ControllerCMS.MyCMSApp> }
boleroScript
}
}
Controller.fs
type MyApp() =
inherit ProgramComponent<Model, Message>()
override this.Program =
let remote : RemoteServices =
{
login = this.Remote<Login.RemoteService>()
}
let init _ = initModel, initCmd
let update message model = update remote message model
Program.mkProgram init update view
|> Program.withRouter router
ControllerCMS.fs
type MyCMSApp() =
inherit ProgramComponent<Model, Message>()
override this.Program =
let init _ =
initModel, Cmd.none
Program.mkProgram init update view
|> Program.withRouter router
EDIT 25-06-2022
In Blazor, the problem with different css styles can be dealt with this way. Is it possible to use the same approach in Bolero or not?
module Main
open System
open System.Threading
open System.Threading.Tasks
open NetMQ
open NetMQ.Sockets
let uri = "ipc://hello-world"
let f (token : CancellationToken) =
use server = new ResponseSocket()
use poller = new NetMQPoller()
poller.Add(server)
printfn "Server is binding to: %s" uri
server.Bind(uri)
printfn <| "Done binding."
use __ = server.ReceiveReady.Subscribe(fun x ->
if token.CanBeCanceled then poller.Stop()
)
use __ = server.SendReady.Subscribe(fun x ->
if token.CanBeCanceled then poller.Stop()
)
poller.Run()
printfn "Server closing."
server.Unbind(uri)
let src = new CancellationTokenSource()
let token = src.Token
let task = Task.Run((fun () -> f token), token)
src.CancelAfter(100)
task.Wait() // Does not trigger.
My failed attempt looks something like this. The problem is that the poller will only check the cancellation token if it gets or sends a message. I guess one way to do it would be to send a special cancel message from the client rather than these tokens, but that would not work if the server gets into a send state.
What would be a reliable way of closing the server in NetMQ?
I created a default SAFE app as described here.
Removing redundant stuff, the server is this:
open Giraffe
open Saturn
let webApp = scope {
get "/api/init" (fun next ctx ->
task {
let number = 42
let! counter = task { return number }
return! Successful.OK counter next ctx
})
}
let app = application {
url ("http://0.0.0.0:8085/")
router webApp
memory_cache
use_static "../Client/public"
use_gzip
}
run app
Now, when running app, I see some logging in the console, basically incoming requests:
info: Microsoft.AspNetCore.Hosting.Internal.WebHost[1]
Request starting HTTP/1.1 GET http://localhost:8085/api/init
How do I customize the logging? The docs are as scarce as possible, no examples. I need something simple, like logging "going to return 42...".
Or at least some links with cases.
You can pull the fully blown ILogger object from the context, ctx.
Open Microsoft.Extensions.Logging module and then you can do things like this:
let webApp = scope {
get "/api/init" (fun next ctx ->
task {
let logger = ctx.GetLogger();
let number = 42
logger.Log(LogLevel.Information, "Going to return " + number.ToString())
let! counter = task { return number }
return! Successful.OK counter next ctx
})
}
This will bring to your console:
info: object[0]
Going to return 42
I do not have any proper references. I found a similar thing at the Github of Giraffe server for which Saturn is basically a set of abstractions.
Logging configuration is built into v0.9 at least. I used the case below for myself to suppress most of the logging.
open Microsoft.Extensions.Logging
let app = application {
url ("http://0.0.0.0:8085/")
use_router webApp
logging (fun logger -> logger.SetMinimumLevel LogLevel.Critical |> ignore)
}
I am working on Suave 1.0 + Angular 2.0 sample app and very interesting to start Suave server in watch mode, so the server watch file changes (js,css,html) in root folder and sub-folders and automatically send refresh command to all open browser tabs with my application when any file is changed.
lite-server from Angular 2 5min Quckstark can do this and it is very handy.
I think that most of watch pieces can be found in latest Steffen Forkmann's post but it is not very clean how to send refresh to the open browser tabs.
Please provide complete code of similar implementation with Suave.
The code of Suave server should looks similar to this
#r "packages/Suave/lib/net40/suave.dll"
#r "packages/FAKE/tools/FakeLib.dll"
open Fake
open Suave
open Suave.Operators
open Suave.Sockets.Control
open Suave.WebSocket
open Suave.Utils
open Suave.Files
open Suave.RequestErrors
open Suave.Filters
open System
open System.Net
let port =
let rec findPort port =
let portIsTaken =
System.Net.NetworkInformation.IPGlobalProperties.GetIPGlobalProperties().GetActiveTcpListeners()
|> Seq.exists (fun x -> x.Port = int(port))
if portIsTaken then findPort (port + 1us) else port
findPort 8083us
let logger = Logging.Loggers.ConsoleWindowLogger Logging.LogLevel.Verbose
let refreshEvent = new Event<_>()
let handleWatcherEvents (events:FileChange seq) =
for e in events do
let fi = fileInfo e.FullPath
traceImportant <| sprintf "%s was changed." fi.Name
refreshEvent.Trigger()
let socketHandler (webSocket : WebSocket) =
fun cx -> socket {
while true do
let! refreshed =
Control.Async.AwaitEvent(refreshEvent.Publish)
|> Suave.Sockets.SocketOp.ofAsync
do! webSocket.send Text (ASCII.bytes "refreshed") true
}
let cfg =
{ defaultConfig with
homeFolder = Some (__SOURCE_DIRECTORY__)
bindings =
[ HttpBinding.mk HTTP IPAddress.Loopback port ]
listenTimeout = TimeSpan.FromMilliseconds 3000. }
let app : WebPart =
choose [
Filters.log logger logFormat >=> never
Filters.path "/websocket" >=> handShake socketHandler
Filters.GET >=> Filters.path "/" >=> file "index.html"
Writers.setHeader "Cache-Control" "no-cache, no-store, must-revalidate"
>=> Writers.setHeader "Pragma" "no-cache"
>=> Writers.setHeader "Expires" "0"
>=> browseHome
NOT_FOUND "Found no handlers."
]
let watcher =
!! ("app/*.js")
++ ("*.html")
|> WatchChanges handleWatcherEvents
try
System.Diagnostics.Process.Start(sprintf "http://localhost:%d/index.html" port) |> ignore
startWebServer cfg app
finally
watcher.Dispose()
So we setup watcher that handle changes in js(generated by TypeScript) and html files and send refresh command to the client, but in the same time we need to add following code to the head section of index.html to handle refresh on the client side
<!-- 3. Listen on refresh events from the server -->
<script language="javascript" type="text/javascript">
function init()
{
websocket = new WebSocket("ws://"+window.location.host+"/websocket");
websocket.onmessage = function(evt) { location.reload(); };
}
window.addEventListener("load", init, false);
</script>
The full demo app you can find here
EDIT for moderators
I had this issue this morning, but the problem has been somehow solved on its own. If it were to come back and I could exactly tell what is happening I would reopen another question with more details.
Thx
I have the following code to start a http listener (I have so far copied and pasted a lot from this series of article )
httpAgent.fs :
namespace Server.Core
open System.Net
open System.Threading
type Agent<'T> = MailboxProcessor<'T>
/// HttpAgent that listens for HTTP requests and handles
/// them using the function provided to the Start method
type HttpAgent private (url, f) as this =
let tokenSource = new CancellationTokenSource()
let agent = Agent.Start((fun _ -> f this), tokenSource.Token)
let server = async {
use listener = new HttpListener()
listener.Prefixes.Add(url)
listener.Start()
while true do
let! context = listener.AsyncGetContext()
agent.Post(context) }
do Async.Start(server, cancellationToken = tokenSource.Token)
/// Asynchronously waits for the next incomming HTTP request
/// The method should only be used from the body of the agent
member x.Receive(?timeout) = agent.Receive(?timeout = timeout)
/// Stops the HTTP server and releases the TCP connection
member x.Stop() = tokenSource.Cancel()
/// Starts new HTTP server on the specified URL. The specified
/// function represents computation running inside the agent.
static member Start(url, f) =
new HttpAgent(url, f)
httpServer.fs :
module httpServer
open Server.Core
let execute = fun ( server : HttpAgent) -> async {
while true do
let! ctx = server.Receive()
ctx.Response.Reply(ctx.Request.InputString) }
This code runs well in a console project (ie: I can access it with a browser, it does find it) :
[<EntryPoint>]
let main argv =
let siteRoot = #"D:\Projects\flaming-octo-spice\src\Site"
let url = "http://localhost:8082/"
let server = HttpAgent.Start(url, httpServer.execute)
printfn "%A" argv
let s = Console.ReadLine()
// Stop the HTTP server and release the port 8082
server.Stop()
0 // return an integer exit code
whereas in my test, I cannot access the server. I have even put some breakpoint in order to check with my browser if the server was up and running , but chrome tells me no host exists with ths url.
namespace UnitTestProject1
open System
open Microsoft.VisualStudio.TestTools.UnitTesting
open Server.Core
open System.Net.Http
[<TestClass>]
type HttpServerTests() =
[<TestMethod>]
member x.Should_start_a_web_site_with_host_address () =
let host = "http://localhost:8082/"
let server = HttpAgent.Start(host, httpServer.execute)
let url = "http://localhost:8082/test/url"
let client = new HttpClient()
let response = client.GetAsync(url)
Assert.IsTrue(response.Result.IsSuccessStatusCode )
Thanks for any enlightment...
You're starting server at port 8092, but client tries to access it at 8082.