Support multiple trigger targets

This commit is contained in:
Daniel J. Summers 2021-10-04 13:54:07 -04:00
parent de6c41297d
commit 98175b9b31

View File

@ -51,57 +51,51 @@ type HttpRequest with
[<AutoOpen>] [<AutoOpen>]
module Handlers = module Handlers =
/// Serialize an object to JSON (supports triggering multiple events) /// Serialize a list of key/value pairs to JSON (very rudimentary)
let private toJson (it : obj) = let private toJson (evts : (string * string) list) =
match it with evts
| :? string as x -> x |> List.map (fun evt -> sprintf "\"%s\": \"%s\"" (fst evt) ((snd evt).Replace ("\"", "\\\"")))
| _ -> "" // TODO: serialize object |> String.concat ", "
|> StringValues |> (sprintf "{ %s }" >> StringValues)
/// Pushes a new url into the history stack /// Set a header
let private setHeader item value : HttpHandler =
fun next ctx ->
ctx.Response.Headers.[item] <- value
next ctx
// Pushes a new url into the history stack
let withHxPush (push : bool) : HttpHandler = let withHxPush (push : bool) : HttpHandler =
fun next ctx -> task { push |> (string >> StringValues >> setHeader "HX-Push")
ctx.Response.Headers.["HX-Push"] <- push |> (string >> StringValues)
return! next ctx
}
/// Can be used to do a client-side redirect to a new location /// Can be used to do a client-side redirect to a new location
let withHxRedirect (url : string) : HttpHandler = let withHxRedirect (url : string) : HttpHandler =
fun next ctx -> task { StringValues url |> setHeader "HX-Redirect"
ctx.Response.Headers.["HX-Redirect"] <- StringValues url
return! next ctx
}
/// If set to `true` the client side will do a a full refresh of the page /// If set to `true` the client side will do a a full refresh of the page
let withHxRefresh (refresh : bool) : HttpHandler = let withHxRefresh (refresh : bool) : HttpHandler =
fun next ctx -> task { refresh |> (string >> StringValues >> setHeader "HX-Refresh")
ctx.Response.Headers.["HX-Redirect"] <- refresh |> (string >> StringValues)
return! next ctx
}
/// Allows you to trigger client side events /// Allows you to trigger a single client side event
/// let withHxTrigger (evt : string) : HttpHandler =
/// _(strings will be passed verbatim; objects will be JSON-encoded)_ StringValues evt |> setHeader "HX-Trigger"
let withHxTrigger (trig : obj) : HttpHandler =
fun next ctx -> task {
ctx.Response.Headers.["HX-Trigger"] <- toJson trig
return! next ctx
}
/// Allows you to trigger client side events after changes have settled /// Allows you to trigger multiple client side events
/// let withHxTriggerMany evts : HttpHandler =
/// _(strings will be passed verbatim; objects will be JSON-encoded)_ toJson evts |> setHeader "HX-Trigger"
let withHxTriggerAfterSettle (trig : obj) : HttpHandler =
fun next ctx -> task {
ctx.Response.Headers.["HX-Trigger-After-Settle"] <- toJson trig
return! next ctx
}
/// Allows you to trigger client side events after DOM swapping occurs /// Allows you to trigger a single client side event after changes have settled
/// let withHxTriggerAfterSettle (evt : string) : HttpHandler =
/// _(strings will be passed verbatim; objects will be JSON-encoded)_ StringValues evt |> setHeader "HX-Trigger-After-Settle"
let withHxTriggerAfterSwap (trig : obj) : HttpHandler =
fun next ctx -> task { /// Allows you to trigger multiple client side events after changes have settled
ctx.Response.Headers.["HX-Trigger-After-Swap"] <- toJson trig let withHxTriggerManyAfterSettle evts : HttpHandler =
return! next ctx toJson evts |> setHeader "HX-Trigger-After-Settle"
}
/// Allows you to trigger a single client side event after DOM swapping occurs
let withHxTriggerAfterSwap (evt : string) : HttpHandler =
StringValues evt |> setHeader "HX-Trigger-After-Swap"
/// Allows you to trigger multiple client side events after DOM swapping occurs
let withHxTriggerManyAfterSwap evts : HttpHandler =
toJson evts |> setHeader "HX-Trigger-After-Swap"