bit-badger/myWebLog
1
0
Fork 0
Code Issues 2 Pull Requests Packages Projects Releases 11 Activity

WIP on htmx 4; user messages now work (#60)

Browse Source
This commit is contained in:
Daniel J. Summers
2026-07-12 14:08:32 -04:00
parent d31b508359
commit 0fcb40fbdd
4 changed files with 26 additions and 33 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/MyWebLog/Handlers/Helpers.fs
+8 -16
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) pushUrl : HttpHandler =
let messagesToHeaders (messages: UserMessage array) : HttpHandler =
seq {
yield!
messages
@@ -116,10 +116,7 @@ let messagesToHeaders (messages: UserMessage array) pushUrl : HttpHandler =
| Some detail -> $"{m.Level}|||{m.Message}|||{detail}"
| None -> $"{m.Level}|||{m.Message}"
|> setHttpHeader "X-Message")
match pushUrl with
| Some true -> withHxPushUrl "true"
| Some false -> withHxNoPushUrl
| None -> ()
withHxNoPushUrl
}
|> Seq.reduce (>=>)
@@ -158,7 +155,7 @@ module Error =
{ UserMessage.Error with
Message = $"You are not authorized to access the URL {ctx.Request.Path.Value}" }
|]
(messagesToHeaders messages (Some false) >=> setStatusCode 401) earlyReturn ctx
(messagesToHeaders messages >=> setStatusCode 401) earlyReturn ctx
else setStatusCode 401 earlyReturn ctx
/// Handle 404s
@@ -168,14 +165,14 @@ module Error =
let messages = [|
{ UserMessage.Error with Message = $"The URL {ctx.Request.Path.Value} was not found" }
|]
RequestErrors.notFound (messagesToHeaders messages (Some false)) earlyReturn ctx
RequestErrors.notFound (messagesToHeaders messages) 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 (Some false)) earlyReturn ctx
ServerErrors.internalError (messagesToHeaders messages) earlyReturn ctx
else ServerErrors.INTERNAL_ERROR message earlyReturn ctx)
@@ -215,7 +212,7 @@ let bareForTheme themeId template next ctx viewCtx = task {
match! Template.Cache.get themeId "layout-bare" ctx.Data with
| Ok layoutTemplate ->
return!
(messagesToHeaders completeCtx.Messages (Some false)
(messagesToHeaders completeCtx.Messages
>=> 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
@@ -231,12 +228,7 @@ 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
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
return! (layout content appCtx |> RenderView.AsString.htmlDocument |> htmlString) next ctx
}
/// Display a bare page for an admin endpoint
@@ -244,7 +236,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 (Some false)
(messagesToHeaders appCtx.Messages
>=> htmlString (Layout.bare content appCtx |> RenderView.AsString.htmlDocument)) next ctx
}