WIP on htmx 4 integration (#60)

This commit is contained in:
2026-07-11 21:33:07 -04:00
parent 32372a3f9f
commit d31b508359
7 changed files with 72 additions and 68 deletions
+17 -9
View File
@@ -107,7 +107,7 @@ let isHtmx (ctx: HttpContext) =
ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh
/// Convert messages to headers (used for htmx responses)
let messagesToHeaders (messages: UserMessage array) : HttpHandler =
let messagesToHeaders (messages: UserMessage array) pushUrl : HttpHandler =
seq {
yield!
messages
@@ -116,7 +116,10 @@ let messagesToHeaders (messages: UserMessage array) : HttpHandler =
| Some detail -> $"{m.Level}|||{m.Message}|||{detail}"
| None -> $"{m.Level}|||{m.Message}"
|> setHttpHeader "X-Message")
withHxNoPushUrl
match pushUrl with
| Some true -> withHxPushUrl "true"
| Some false -> withHxNoPushUrl
| None -> ()
}
|> Seq.reduce (>=>)
@@ -155,7 +158,7 @@ module Error =
{ UserMessage.Error with
Message = $"You are not authorized to access the URL {ctx.Request.Path.Value}" }
|]
(messagesToHeaders messages >=> setStatusCode 401) earlyReturn ctx
(messagesToHeaders messages (Some false) >=> setStatusCode 401) earlyReturn ctx
else setStatusCode 401 earlyReturn ctx
/// Handle 404s
@@ -165,14 +168,14 @@ module Error =
let messages = [|
{ UserMessage.Error with Message = $"The URL {ctx.Request.Path.Value} was not found" }
|]
RequestErrors.notFound (messagesToHeaders messages) earlyReturn ctx
RequestErrors.notFound (messagesToHeaders messages (Some false)) earlyReturn ctx
else RequestErrors.NOT_FOUND "Not found" earlyReturn ctx)
let server message : HttpHandler =
handleContext (fun ctx ->
if isHtmx ctx then
let messages = [| { UserMessage.Error with Message = message } |]
ServerErrors.internalError (messagesToHeaders messages) earlyReturn ctx
ServerErrors.internalError (messagesToHeaders messages (Some false)) earlyReturn ctx
else ServerErrors.INTERNAL_ERROR message earlyReturn ctx)
@@ -212,8 +215,8 @@ let bareForTheme themeId template next ctx viewCtx = task {
match! Template.Cache.get themeId "layout-bare" ctx.Data with
| Ok layoutTemplate ->
return!
(messagesToHeaders completeCtx.Messages >=> htmlString (Template.render layoutTemplate completeCtx ctx.Data))
next ctx
(messagesToHeaders completeCtx.Messages (Some false)
>=> htmlString (Template.render layoutTemplate completeCtx ctx.Data)) next ctx
| Error message -> return! Error.server message next ctx
| Error message -> return! Error.server message next ctx
}
@@ -228,7 +231,12 @@ let adminPage pageTitle next ctx (content: AppViewContext -> XmlNode list) = tas
let! messages = getCurrentMessages ctx
let appCtx = generateViewContext messages (viewCtxForPage pageTitle) ctx
let layout = if isHtmx ctx then Layout.partial else Layout.full
return! htmlString (layout content appCtx |> RenderView.AsString.htmlDocument) next ctx
let returnFunc html =
if isHtmx ctx && messages.Length > 0 then
messagesToHeaders messages None >=> htmlString html
else
htmlString html
return! (layout content appCtx |> RenderView.AsString.htmlDocument |> returnFunc) next ctx
}
/// Display a bare page for an admin endpoint
@@ -236,7 +244,7 @@ let adminBarePage pageTitle next ctx (content: AppViewContext -> XmlNode list) =
let! messages = getCurrentMessages ctx
let appCtx = generateViewContext messages (viewCtxForPage pageTitle) ctx
return!
( messagesToHeaders appCtx.Messages
( messagesToHeaders appCtx.Messages (Some false)
>=> htmlString (Layout.bare content appCtx |> RenderView.AsString.htmlDocument)) next ctx
}