WIP on htmx 4 integration (#60)
This commit is contained in:
@@ -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
|
||||
}
|
||||
|
||||
|
||||
Reference in New Issue
Block a user