diff --git a/src/MyPrayerJournal/Server/Handlers.fs b/src/MyPrayerJournal/Server/Handlers.fs index 37f47ba..099622a 100644 --- a/src/MyPrayerJournal/Server/Handlers.fs +++ b/src/MyPrayerJournal/Server/Handlers.fs @@ -11,18 +11,7 @@ open MyPrayerJournal.Data.Extensions /// Send a partial result if this is not a full page load let partialIfNotRefresh content : HttpHandler = fun next ctx -> task { - let hdrs = Headers.fromRequest ctx - let isHtmx = - hdrs - |> List.filter HtmxReqHeader.isRequest - |> List.tryHead - |> Option.isSome - let isRefresh = - hdrs - |> List.filter HtmxReqHeader.isHistoryRestoreRequest - |> List.tryHead - |> function Some (HistoryRestoreRequest hist) -> hist | _ -> false - match isHtmx && not isRefresh with + match ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh with | true -> return! ctx.WriteHtmlViewAsync content | false -> return! Views.Layout.view content |> ctx.WriteHtmlViewAsync } @@ -32,7 +21,7 @@ module Vue = /// The application index page let app : HttpHandler = - Headers.toResponse (Trigger "menu-refresh") + withHxTrigger "menu-refresh" >=> partialIfNotRefresh (ViewEngine.HtmlElements.str "It works") @@ -110,8 +99,7 @@ module private Helpers = /// Trigger a menu item refresh let withMenuRefresh : HttpHandler = - // let trigger = //string ctx.Request.Path |> sprintf "{ \"menu-refresh\": \"%s\" }" :> obj |> TriggerAfterSwap - Headers.toResponse (TriggerAfterSettle "menu-refresh") + withHxTriggerAfterSettle "menu-refresh" /// Render a component result let renderComponent nodes : HttpHandler = @@ -120,7 +108,6 @@ module private Helpers = } - /// Strongly-typed models for post requests module Models = @@ -174,10 +161,7 @@ module Components = // GET /components/nav-items let navItems : HttpHandler = fun next ctx -> task { - let url = - Headers.fromRequest ctx - |> List.tryFind HtmxReqHeader.isCurrentUrl - |> function Some (CurrentUrl u) -> Some u | _ -> None + let url = ctx.Request.Headers.HxCurrentUrl let isAuthorized = ctx |> (user >> Option.isSome) return! renderComponent (Views.Navigation.currentNav isAuthorized false url) next ctx } diff --git a/src/MyPrayerJournal/Server/Htmx.fs b/src/MyPrayerJournal/Server/Htmx.fs deleted file mode 100644 index c0f1815..0000000 --- a/src/MyPrayerJournal/Server/Htmx.fs +++ /dev/null @@ -1,102 +0,0 @@ -module Giraffe.Htmx - -open System - -/// HTMX request header values -type HtmxReqHeader = -/// Indicates that the request is via an element using `hx-boost` -| Boosted of string -/// The current URL of the browser -| CurrentUrl of Uri -/// `true` if the request is for history restoration after a miss in the local history cache -| HistoryRestoreRequest of bool -/// The user response to an hx-prompt -| Prompt of string -/// Always `true` -| Request of bool -/// The `id` of the target element if it exists -| Target of string -/// The `id` of the triggered element if it exists -| Trigger of string -/// The `name` of the triggered element if it exists -| TriggerName of string - -/// Functions for manipulating htmx request headers -module HtmxReqHeader = - /// True if this is an `HX-Boosted` header, false if not - let isBoosted = function Boosted _ -> true | _ -> false - /// True if this is an `HX-Current-URL` header, false if not - let isCurrentUrl = function CurrentUrl _ -> true | _ -> false - /// True if this is an `HX-History-Restore-Request` header, false if not - let isHistoryRestoreRequest = function HistoryRestoreRequest _ -> true | _ -> false - /// True if this is an `HX-Prompt` header, false if not - let isPrompt = function Prompt _ -> true | _ -> false - /// True if this is an `HX-Request` header, false if not - let isRequest = function Request _ -> true | _ -> false - /// True if this is an `HX-Target` header, false if not - let isTarget = function Target _ -> true | _ -> false - /// True if this is an `HX-Trigger` header, false if not - let isTrigger = function Trigger _ -> true | _ -> false - /// True if this is an `HX-Trigger-Name` header, false if not - let isTriggerName = function TriggerName _ -> true | _ -> false - - -/// HTMX response header values -type HtmxResHeader = -/// Pushes a new url into the history stack -| Push of bool -/// Can be used to do a client-side redirect to a new location -| Redirect of string -/// If set to `true` the client side will do a a full refresh of the page -| Refresh of bool -/// Allows you to trigger client side events -| Trigger of obj -/// Allows you to trigger client side events after changes have settled -| TriggerAfterSettle of obj -/// Allows you to trigger client side events after DOM swapping occurs -| TriggerAfterSwap of obj - - -module Headers = - - open Microsoft.AspNetCore.Http - open Microsoft.Extensions.Primitives - - /// Get the HTMX headers from the request context - let fromRequest (ctx : HttpContext) = - ctx.Request.Headers.Keys - |> Seq.filter (fun key -> key.StartsWith "HX-") - |> Seq.map (fun key -> - let v = ctx.Request.Headers.[key].[0] - match key with - | "HX-Boosted" -> v |> (Boosted >> Some) - | "HX-Current-URL" -> v |> (Uri >> CurrentUrl >> Some) - | "HX-History-Restore-Request" -> v |> (bool.Parse >> HistoryRestoreRequest >> Some) - | "HX-Prompt" -> v |> (Prompt >> Some) - | "HX-Request" -> v |> (bool.Parse >> Request >> Some) - | "HX-Target" -> v |> (Target >> Some) - | "HX-Trigger" -> v |> (HtmxReqHeader.Trigger >> Some) - | "HX-Trigger-Name" -> v |> (TriggerName >> Some) - | _ -> None - ) - |> Seq.filter Option.isSome - |> Seq.map Option.get - |> List.ofSeq - - /// Add an htmx header to the response - let toResponse (hdr : HtmxResHeader) : HttpHandler = - let toJson (it : obj) = - match it with - | :? string as x -> x - | _ -> "" // TODO: serialize object - fun next ctx -> task { - match hdr with - | Push push -> "HX-Push", string push - | Redirect url -> "HX-Redirect", url - | Refresh refresh -> "HX-Refresh", string refresh - | Trigger trig -> "HX-Trigger", toJson trig - | TriggerAfterSettle trig -> "HX-Trigger-After-Settle", toJson trig - | TriggerAfterSwap trig -> "HX-Trigger-After-Swap", toJson trig - |> function (k, v) -> ctx.Response.Headers.Add (k, StringValues v) - return! next ctx - } diff --git a/src/MyPrayerJournal/Server/MyPrayerJournal.Server.fsproj b/src/MyPrayerJournal/Server/MyPrayerJournal.Server.fsproj index 3d241bc..8d0e37f 100644 --- a/src/MyPrayerJournal/Server/MyPrayerJournal.Server.fsproj +++ b/src/MyPrayerJournal/Server/MyPrayerJournal.Server.fsproj @@ -4,8 +4,6 @@ 3.0.0.0 - - @@ -20,6 +18,10 @@ + + + + diff --git a/src/MyPrayerJournal/Server/ViewEngine.Htmx.fs b/src/MyPrayerJournal/Server/ViewEngine.Htmx.fs deleted file mode 100644 index ea911c0..0000000 --- a/src/MyPrayerJournal/Server/ViewEngine.Htmx.fs +++ /dev/null @@ -1,136 +0,0 @@ -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 - -[] -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" -