Redirect after post works

src/MyPrayerJournal/Server/.gitignore

@@ -12,5 +12,8 @@ wwwroot/*.js.map
 wwwroot/css
 wwwroot/js
 
+## Local library files
+wwwroot/script/htmx*.js
+
 ## Development settings
 appsettings.Development.json

src/MyPrayerJournal/Server/Domain.fs

@@ -171,16 +171,17 @@ module JournalRequest =
 
   /// Convert a request to the form used for the journal (precomputed values, no notes or history)
   let ofRequestLite (req : Request) =
-    let hist = req.history |> List.sortByDescending (fun it -> Ticks.toLong it.asOf) |> List.head
+    let hist = req.history |> List.sortByDescending (fun it -> Ticks.toLong it.asOf) |> List.tryHead
     { requestId    = req.id
       userId       = req.userId
-      text         = (req.history
+      text         = req.history
-                       |> List.filter (fun it -> Option.isSome it.text)
+                      |> List.filter (fun it -> Option.isSome it.text)
-                       |> List.sortByDescending (fun it -> Ticks.toLong it.asOf)
+                      |> List.sortByDescending (fun it -> Ticks.toLong it.asOf)
-                       |> List.head).text
+                      |> List.tryHead
-                     |> Option.get
+                      |> Option.map (fun h -> Option.get h.text)
-      asOf         = hist.asOf
+                      |> Option.defaultValue ""
-      lastStatus   = hist.status
+      asOf         = match hist with Some h -> h.asOf | None -> Ticks 0L
+      lastStatus   = match hist with Some h -> h.status | None -> Created
       snoozedUntil = req.snoozedUntil
       showAfter    = req.showAfter
       recurType    = req.recurType

src/MyPrayerJournal/Server/Handlers.fs

@@ -34,7 +34,10 @@ module Error =
   /// Handle errors
   let error (ex : Exception) (log : ILogger) =
     log.LogError (EventId(), ex, "An unhandled exception has occurred while executing the request.")
-    clearResponse >=> setStatusCode 500 >=> json ex.Message
+    clearResponse
+    >=> setStatusCode 500
+    >=> setHttpHeader (sprintf "error|||%s: %s" (ex.GetType().Name) ex.Message) "X-Toast"
+    >=> text ex.Message
 
   /// Handle unauthorized actions, redirecting to log on for GETs, otherwise returning a 401 Not Authorized reponse
   let notAuthorized : HttpHandler =
@@ -49,6 +52,30 @@ module Error =
     setStatusCode 404 >=> text "Not found"
 
 
+/// Hold messages across redirects
+module Messages =
+
+  /// The messages being held
+  let mutable private messages : Map<string, (string * string)> = Map.empty
+
+  /// Locked update to prevent updates by multiple threads
+  let private upd8 = obj ()
+
+  /// Push a new message into the list
+  let push userId message url = lock upd8 (fun () ->
+    messages <- messages.Add (userId, (message, url)))
+
+  /// Add a success message header to the response
+  let pushSuccess userId message url =
+    push userId (sprintf "success|||%s" message) url
+  
+  /// Pop the messages for the given user
+  let pop userId = lock upd8 (fun () ->
+    let msg = messages.TryFind userId
+    msg |> Option.iter (fun _ -> messages <- messages.Remove userId)
+    msg)
+
+
 /// Handler helpers
 [<AutoOpen>]
 module private Helpers =
@@ -116,12 +143,18 @@ module private Helpers =
   /// Send a partial result if this is not a full page load
   let partialIfNotRefresh (pageTitle : string) content : HttpHandler =
     fun next ctx ->
+      let isPartial = ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh
       let view =
         pageContext ctx pageTitle content
-        |> match ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh with
+        |> match isPartial with true -> Views.Layout.partial | false -> Views.Layout.view
-           | true -> Views.Layout.partial
+      (next, ctx)
-           | false -> Views.Layout.view
+      ||> match user ctx with
-      writeView view next ctx
+          | Some u ->
+              match Messages.pop u with
+              | Some (msg, url) -> setHttpHeader "X-Toast" msg >=> withHxPush url >=> writeView view
+              | None -> writeView view
+          | None -> writeView view
+
 
   /// Add a success message header to the response
   let withSuccessMessage : string -> HttpHandler =
@@ -143,6 +176,8 @@ module Models =
   type Request = {
     /// The ID of the request
     requestId     : string
+    /// Where to redirect after saving
+    returnTo      : string
     /// The text of the request
     requestText   : string
     /// The additional status to record
@@ -185,10 +220,10 @@ module Components =
       match requestId with
       | "new" ->
           return! partialIfNotRefresh "Add Prayer Request"
-                    (Views.Request.edit (JournalRequest.ofRequestLite Request.empty) false) next ctx
+                    (Views.Request.edit (JournalRequest.ofRequestLite Request.empty) "" false) next ctx
       | _ ->
           match! Data.tryJournalById (RequestId.ofString requestId) (userId ctx) (db ctx) with
-          | Some req -> return! partialIfNotRefresh "Edit Prayer Request" (Views.Request.edit req false) next ctx
+          | Some req -> return! partialIfNotRefresh "Edit Prayer Request" (Views.Request.edit req "" false) next ctx
           | None -> return! Error.notFound next ctx
       }
 
@@ -245,6 +280,26 @@ module Ply = FSharp.Control.Tasks.Affine
 /// /api/request and /request(s) URLs
 module Request =
 
+  // GET /request/[req-id]/edit  
+  let edit requestId : HttpHandler =
+    requiresAuthentication Error.notAuthorized
+    >=> fun next ctx -> task {
+      let returnTo =
+        match ctx.Request.Headers.Referer.[0] with
+        | it when it.EndsWith "/active" -> "active"
+        | it when it.EndsWith "/snoozed" -> "snoozed"
+        | _ -> "journal"
+      match requestId with
+      | "new" ->
+          return! partialIfNotRefresh "Add Prayer Request"
+                    (Views.Request.edit (JournalRequest.ofRequestLite Request.empty) returnTo true) next ctx
+      | _ ->
+          match! Data.tryJournalById (RequestId.ofString requestId) (userId ctx) (db ctx) with
+          | Some req ->
+              return! partialIfNotRefresh "Edit Prayer Request" (Views.Request.edit req returnTo false) next ctx
+          | None -> return! Error.notFound next ctx
+      }
+
   // PATCH /request/[req-id]/prayed
   let prayed requestId : HttpHandler =
     requiresAuthentication Error.notAuthorized
@@ -410,8 +465,12 @@ module Request =
           }
       Data.addRequest req db
       do! db.saveChanges ()
+      Messages.pushSuccess (ctx |> (user >> Option.get)) "Added prayer request" "/journal"
       // TODO: this is not right
-      return! (withHxRedirect "/journal" >=> createdAt (RequestId.toString req.id |> sprintf "/request/%s")) next ctx
+      return! (
+        redirectTo false "/journal"
+        // >=> createdAt (RequestId.toString req.id |> sprintf "/request/%s")
+        ) next ctx
       }
   
   // PATCH /request
@@ -484,6 +543,7 @@ let routes =
       ]
     subRoute "/request" [
       GET_HEAD [
+        routef "/%s/edit"   Request.edit
         routef "/%s/full"   Request.getFull
         route  "s/active"   Request.active
         route  "s/answered" Request.answered

src/MyPrayerJournal/Server/Program.fs

@@ -141,14 +141,16 @@ module Configure =
 
   /// Configure the web application
   let application (app : WebApplication) =
-    match app.Environment.IsDevelopment () with
+    // match app.Environment.IsDevelopment () with
-    | true -> app.UseDeveloperExceptionPage ()
+    // | true -> app.UseDeveloperExceptionPage ()
-    | false -> app.UseGiraffeErrorHandler Handlers.Error.error
+    // | false -> app.UseGiraffeErrorHandler Handlers.Error.error
-    |> ignore
+    // |> ignore
-    app.UseStaticFiles()
+    app
+      .UseStaticFiles()
       .UseCookiePolicy()
       .UseRouting()
       .UseAuthentication()
+      .UseGiraffeErrorHandler(Handlers.Error.error)
       // .UseAuthorization()
       .UseEndpoints (fun e ->
           e.MapGiraffeEndpoints Handlers.routes

src/MyPrayerJournal/Server/Views.fs

@@ -309,6 +309,9 @@ module Journal =
       | _ -> rawText "’s"
       str " Prayer Journal"
       ]
+    p [ _class "pb-3 text-center" ] [
+      pageLink "/request/new/edit" [ _class "btn btn-primary "] [ icon "add_box"; str " Add a Prayer Request" ]
+      ]
     p [
       _hxGet     "/components/journal-items"
       _hxSwap    HxSwap.OuterHtml
@@ -472,16 +475,26 @@ module Request =
       ]
 
   /// View for the edit request component
-  let edit (req : JournalRequest) isNew =
+  let edit (req : JournalRequest) returnTo isNew =
-    let cancelUrl = req.requestId |> (RequestId.toString >> sprintf "/components/request/%s/item")
+    let cancelLink =
-    section [ _class "container list-group-item"; _hxTarget "this"; _hxSwap HxSwap.OuterHtml ] [
+      match returnTo with
+      | "active"          -> "/requests/active"
+      | "snoozed"         -> "/requests/snoozed"
+      | _ (* "journal" *) -> "/journal"
+    article [ _class "container" ] [
       h5 [ _class "pb-3" ] [ (match isNew with true -> "Add" | false -> "Edit") |> strf "%s Prayer Request" ]
-      form [ "/request" |> match isNew with true -> _hxPost | false -> _hxPatch ] [
+      form [
+        _hxBoost
+        _hxTarget "#top"
+        _hxPushUrl
+        "/request" |> match isNew with true -> _hxPost | false -> _hxPatch
+        ] [
         input [
           _type  "hidden"
           _name  "requestId"
           _value (match isNew with true -> "new" | false -> RequestId.toString req.requestId)
           ]
+        input [ _type "hidden"; _name "returnTo"; _value returnTo ]
         div [ _class "form-floating pb-3" ] [
           textarea [
             _id          "requestText"
@@ -578,7 +591,7 @@ module Request =
           ]
         div [ _class "text-end pt-3" ] [
           button [ _class "btn btn-primary me-2"; _type "submit" ] [ icon "save"; str " Save" ]
-          a [ _class "btn btn-secondary ms-2"; _href cancelUrl; _hxGet cancelUrl ] [icon "arrow_back"; str " Cancel"]
+          pageLink cancelLink [ _class "btn btn-secondary ms-2" ] [ icon "arrow_back"; str " Cancel" ]
           ]
         ]
       ]