diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..f181d71 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +**/bin +**/obj diff --git a/src/Htmx/Giraffe.Htmx.fsproj b/src/Htmx/Giraffe.Htmx.fsproj new file mode 100644 index 0000000..6458b75 --- /dev/null +++ b/src/Htmx/Giraffe.Htmx.fsproj @@ -0,0 +1,16 @@ + + + + net6.0 + true + + + + + + + + + + + diff --git a/src/Htmx/Htmx.fs b/src/Htmx/Htmx.fs new file mode 100644 index 0000000..ad3a520 --- /dev/null +++ b/src/Htmx/Htmx.fs @@ -0,0 +1,107 @@ +module Giraffe.Htmx + +open Microsoft.AspNetCore.Http +open Microsoft.Extensions.Primitives +open System + +/// Determine if the given header is present +let private hdr (headers : IHeaderDictionary) hdr = + match headers.[hdr] with it when it = StringValues.Empty -> None | it -> Some it.[0] + +/// Extensions to the header dictionary +type IHeaderDictionary with + + /// Indicates that the request is via an element using `hx-boost` + member this.HxBoosted with get () = hdr this "HX-Boosted" |> Option.map bool.Parse + + /// The current URL of the browser _(note that this does not update until after settle)_ + member this.HxCurrentUrl with get () = hdr this "HX-Current-URL" |> Option.map Uri + + /// `true` if the request is for history restoration after a miss in the local history cache + member this.HxHistoryRestoreRequest with get () = hdr this "HX-History-Restore-Request" |> Option.map bool.Parse + + /// The user response to an `hx-prompt` + member this.HxPrompt with get () = hdr this "HX-Prompt" + + /// Always `true` + member this.HxRequest with get () = hdr this "HX-Request" |> Option.map bool.Parse + + /// The `id` of the target element if it exists + member this.HxTarget with get () = hdr this "HX-Target" + + /// The `id` of the triggered element if it exists + member this.HxTrigger with get () = hdr this "HX-Trigger" + + /// The `name` of the triggered element if it exists + member this.HxTriggerName with get () = hdr this "HX-Trigger-Name" + + +/// Extensions for the request object +type HttpRequest with + + /// Whether this request was initiated from HTMX + member this.IsHtmx with get () = this.Headers.HxRequest |> Option.defaultValue false + + /// Whether this request is an HTMX history-miss refresh request + member this.IsHtmxRefresh with get () = + this.IsHtmx && (this.Headers.HxHistoryRestoreRequest |> Option.defaultValue false) + + +/// HTTP handlers for setting output headers +[] +module Handlers = + + /// Serialize an object to JSON (supports triggering multiple events) + let private toJson (it : obj) = + match it with + | :? string as x -> x + | _ -> "" // TODO: serialize object + |> StringValues + + /// Pushes a new url into the history stack + let withHxPush (push : bool) : HttpHandler = + fun next ctx -> task { + ctx.Response.Headers.["HX-Push"] <- push |> (string >> StringValues) + return! next ctx + } + + /// Can be used to do a client-side redirect to a new location + let withHxRedirect (url : string) : HttpHandler = + fun next ctx -> task { + 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 + let withHxRefresh (refresh : bool) : HttpHandler = + fun next ctx -> task { + ctx.Response.Headers.["HX-Redirect"] <- refresh |> (string >> StringValues) + return! next ctx + } + + /// Allows you to trigger client side events + /// + /// _(strings will be passed verbatim; objects will be JSON-encoded)_ + 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 + /// + /// _(strings will be passed verbatim; objects will be JSON-encoded)_ + 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 + /// + /// _(strings will be passed verbatim; objects will be JSON-encoded)_ + let withHxTriggerAfterSwap (trig : obj) : HttpHandler = + fun next ctx -> task { + ctx.Response.Headers.["HX-Trigger-After-Swap"] <- toJson trig + return! next ctx + } diff --git a/src/ViewEngine.Htmx/Giraffe.ViewEngine.Htmx.fsproj b/src/ViewEngine.Htmx/Giraffe.ViewEngine.Htmx.fsproj new file mode 100644 index 0000000..859c28f --- /dev/null +++ b/src/ViewEngine.Htmx/Giraffe.ViewEngine.Htmx.fsproj @@ -0,0 +1,16 @@ + + + + net6.0 + true + + + + + + + + + + + diff --git a/src/ViewEngine.Htmx/Htmx.fs b/src/ViewEngine.Htmx/Htmx.fs new file mode 100644 index 0000000..5c8aa40 --- /dev/null +++ b/src/ViewEngine.Htmx/Htmx.fs @@ -0,0 +1,137 @@ +module Giraffe.ViewEngine.Htmx + +/// Valid values for the `hx-encoding` attribute +[] +module HxEncoding = + /// A standard HTTP form + let Form = "application/x-www-form-urlencoded" + /// A multipart form (used for file uploads) + let MultipartForm = "multipart/form-data" + +// TODO: hx-header helper + +/// Values / helpers for the `hx-params` attribute +[] +module HxParams = + /// Include all parameters + let All = "*" + /// Include no parameters + let None = "none" + /// Include the specified parameters + let With fields = fields |> List.reduce (fun acc it -> $"{acc},{it}") + /// Exclude the specified parameters + let Except fields = With fields |> sprintf "not %s" + +// TODO: hx-request helper + +/// Valid values for the `hx-swap` attribute (may be combined with swap/settle/scroll/show config) +[] +module HxSwap = + /// The default, replace the inner html of the target element + let InnerHtml = "innerHTML" + /// Replace the entire target element with the response + let OuterHtml = "outerHTML" + /// Insert the response before the target element + let BeforeBegin = "beforebegin" + /// Insert the response before the first child of the target element + let AfterBegin = "afterbegin" + /// Insert the response after the last child of the target element + let BeforeEnd = "beforeend" + /// Insert the response after the target element + let AfterEnd = "afterend" + /// Does not append content from response (out of band items will still be processed). + let None = "none" + +/// Helpers for the `hx-trigger` attribute +[] +module HxTrigger = + /// Append a filter to a trigger + let private appendFilter filter (trigger : string) = + match trigger.Contains "[" with + | true -> + let parts = trigger.Split ('[', ']') + sprintf "%s[%s&&%s]" parts.[0] parts.[1] filter + | false -> sprintf "%s[%s]" trigger filter + /// Trigger the event on a click + let Click = "click" + /// Trigger the event on page load + let Load = "load" + /// Helpers for defining filters + module Filter = + /// Only trigger the event if the `ALT` key is pressed + let Alt = appendFilter "altKey" + /// Only trigger the event if the `CTRL` key is pressed + let Ctrl = appendFilter "ctrlKey" + /// Only trigger the event if the `SHIFT` key is pressed + let Shift = appendFilter "shiftKey" + /// Only trigger the event if `CTRL+ALT` are pressed + let CtrlAlt = Ctrl >> Alt + /// Only trigger the event if `CTRL+SHIFT` are pressed + let CtrlShift = Ctrl >> Shift + /// Only trigger the event if `CTRL+ALT+SHIFT` are pressed + let CtrlAltShift = CtrlAlt >> Shift + /// Only trigger the event if `ALT+SHIFT` are pressed + let AltShift = Alt >> Shift + + // TODO: more stuff for the hx-trigger helper + +// TODO: hx-vals helper + + +/// Attributes and flags for HTMX +[] +module HtmxAttrs = + /// Progressively enhances anchors and forms to use AJAX requests + let _hxBoost = attr "hx-boost" "true" + /// Shows a confim() dialog before issuing a request + let _hxConfirm = attr "hx-confirm" + /// Issues a DELETE to the specified URL + let _hxDelete = attr "hx-delete" + /// Disables htmx processing for the given node and any children nodes + let _hxDisable = flag "hx-disable" + /// Changes the request encoding type + let _hxEncoding = attr "hx-encoding" + /// Extensions to use for this element + let _hxExt = attr "hx-ext" + /// Issues a GET to the specified URL + let _hxGet = attr "hx-get" + /// Adds to the headers that will be submitted with the request + let _hxHeaders = attr "hx-headers" + /// The element to snapshot and restore during history navigation + let _hxHistoryElt = flag "hx-history-elt" + /// Includes additional data in AJAX requests + let _hxInclude = attr "hx-include" + /// The element to put the htmx-request class on during the AJAX request + let _hxIndicator = attr "hx-indicator" + /// Filters the parameters that will be submitted with a request + let _hxParams = attr "hx-params" + /// Issues a PATCH to the specified URL + let _hxPatch = attr "hx-patch" + /// Issues a POST to the specified URL + let _hxPost = attr "hx-post" + /// Preserves an element between requests + let _hxPreserve = attr "hx-preserve" "true" + /// Shows a prompt before submitting a request + let _hxPrompt = attr "hx-prompt" + /// Pushes the URL into the location bar, creating a new history entry + let _hxPushUrl = flag "hx-push-url" + /// Issues a PUT to the specified URL + let _hxPut = attr "hx-put" + /// Configures various aspects of the request + let _hxRequest = attr "hx-request" + /// Selects a subset of the server response to process + let _hxSelect = attr "hx-select" + /// Establishes and listens to Server Sent Event (SSE) sources for events + let _hxSse = attr "hx-sse" + /// Marks content in a response as being "Out of Band", i.e. swapped somewhere other than the target + let _hxSwapOob = attr "hx-swap-oob" + /// Controls how the response content is swapped into the DOM (e.g. 'outerHTML' or 'beforeEnd') + let _hxSwap = attr "hx-swap" + /// Specifies the target element to be swapped + let _hxTarget = attr "hx-target" + /// Specifies the event that triggers the request + let _hxTrigger = attr "hx-trigger" + /// Adds to the parameters that will be submitted with the request + let _hxVals = attr "hx-vals" + /// Establishes a WebSocket or sends information to one + let _hxWs = attr "hx-ws"