src/MyPrayerJournal/Server/Data.fs

@@ -114,33 +114,6 @@ module private Helpers =
     db.requests.Update req |> ignore
     Task.CompletedTask
 
-  /// Convert a request to the form used for the journal (precomputed values, no notes or history)
-  let toJournalLite (req : Request) =
-    let hist = req.history |> List.sortByDescending (fun it -> Ticks.toLong it.asOf) |> List.head
-    { requestId    = req.id
-      userId       = req.userId
-      text         = (req.history
-                       |> List.filter (fun it -> Option.isSome it.text)
-                       |> List.sortByDescending (fun it -> Ticks.toLong it.asOf)
-                       |> List.head).text
-                     |> Option.get
-      asOf         = hist.asOf
-      lastStatus   = hist.status
-      snoozedUntil = req.snoozedUntil
-      showAfter    = req.showAfter
-      recurType    = req.recurType
-      recurCount   = req.recurCount
-      history      = []
-      notes        = []
-      }
-
-  /// Same as above, but with notes and history
-  let toJournalFull req =
-    { toJournalLite req with 
-        history = req.history
-        notes   = req.notes
-      }
-
 
 /// Retrieve a request, including its history and notes, by its ID and user ID
 let tryFullRequestById reqId userId (db : LiteDatabase) = task {
@@ -171,7 +144,7 @@ let answeredRequests userId (db : LiteDatabase) = task {
   let! reqs = db.requests.Find (Query.EQ ("userId", UserId.toString userId |> BsonValue)) |> toListAsync
   return
     reqs
-    |> Seq.map toJournalFull
+    |> Seq.map JournalRequest.ofRequestFull
     |> Seq.filter (fun it -> it.lastStatus = Answered)
     |> Seq.sortByDescending (fun it -> Ticks.toLong it.asOf)
     |> List.ofSeq
@@ -182,7 +155,7 @@ let journalByUserId userId (db : LiteDatabase) = task {
   let! jrnl = db.requests.Find (Query.EQ ("userId", UserId.toString userId |> BsonValue)) |> toListAsync
   return
     jrnl
-    |> Seq.map toJournalLite
+    |> Seq.map JournalRequest.ofRequestLite
     |> Seq.filter (fun it -> it.lastStatus <> Answered)
     |> Seq.sortBy (fun it -> Ticks.toLong it.asOf)
     |> List.ofSeq
@@ -203,7 +176,7 @@ let notesById reqId userId (db : LiteDatabase) = task {
 /// Retrieve a journal request by its ID and user ID
 let tryJournalById reqId userId (db : LiteDatabase) = task {
   match! tryFullRequestById reqId userId db with
-  | Some req -> return req |> (toJournalLite >> Some)
+  | Some req -> return req |> (JournalRequest.ofRequestLite >> Some)
   | None -> return None
   }
     

src/MyPrayerJournal/Server/Domain.fs

@@ -166,6 +166,36 @@ type JournalRequest =
     notes        : Note list
   }
 
+/// Functions to manipulate journal requests
+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
+    { requestId    = req.id
+      userId       = req.userId
+      text         = (req.history
+                       |> List.filter (fun it -> Option.isSome it.text)
+                       |> List.sortByDescending (fun it -> Ticks.toLong it.asOf)
+                       |> List.head).text
+                     |> Option.get
+      asOf         = hist.asOf
+      lastStatus   = hist.status
+      snoozedUntil = req.snoozedUntil
+      showAfter    = req.showAfter
+      recurType    = req.recurType
+      recurCount   = req.recurCount
+      history      = []
+      notes        = []
+      }
+
+  /// Same as `ofRequestLite`, but with notes and history
+  let ofRequestFull req =
+    { ofRequestLite req with 
+        history = req.history
+        notes   = req.notes
+      }
+
 
 /// Functions to manipulate request actions
 module RequestAction =

src/MyPrayerJournal/Server/Handlers.fs

@@ -57,6 +57,7 @@ module Error =
 open Cuid
 open LiteDB
 open System.Security.Claims
+open Microsoft.Net.Http.Headers
 
 /// Handler helpers
 [<AutoOpen>]
@@ -85,8 +86,14 @@ module private Helpers =
     |> RequestId
 
   /// Return a 201 CREATED response
-  let created next ctx =
+  let created =
-    setStatusCode 201 next ctx
+    setStatusCode 201
+
+  /// Return a 201 CREATED response with the location header set for the created resource
+  let createdAt url : HttpHandler =
+    fun next ctx ->
+      (sprintf "%s://%s%s" ctx.Request.Scheme ctx.Request.Host.Value url |> setHttpHeader HeaderNames.Location
+       >=> created) next ctx
 
   /// The "now" time in JavaScript as Ticks
   let jsNow () =
@@ -146,12 +153,18 @@ module Models =
   /// A prayer request
   [<CLIMutable>]
   type Request = {
+    /// The ID of the request
+    id          : string
     /// The text of the request
     requestText : string
+    /// The additional status to record
+    status      : string option
     /// The recurrence type
     recurType   : string
     /// The recurrence count
-    recurCount  : int16
+    recurCount  : int16 option
+    /// The recurrence interval
+    recurInterval : string option
     }
   
   /// The time until which a request should not appear in the journal
@@ -219,37 +232,79 @@ module Legal =
     withMenuRefresh >=> partialIfNotRefresh "Terms of Service" Views.Legal.termsOfService
 
 
+/// Alias for the Ply task module (The F# "task" CE can't handle differing types well within the same CE)
+module Ply = FSharp.Control.Tasks.Affine
+
+
 /// /api/request and /request(s) URLs
 module Request =
 
-  /// POST /api/request
+  // GET /request/[req-id]/edit  
-  let add : HttpHandler =
+  let edit requestId : HttpHandler =
     authorize
     >=> fun next ctx -> task {
-      let! r     = ctx.BindJsonAsync<Models.Request> ()
+      match requestId with
+      | "new" ->
+          return! partialIfNotRefresh "Add Prayer Request"
+                    (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
+          | None -> return! Error.notFound next ctx
+      }
+
+  /// Add a new prayer request
+  let private addRequest (form : Models.Request) : HttpHandler =
+    fun next ctx -> task {
       let  db    = db ctx
       let  usrId = userId ctx
       let  now   = jsNow ()
-      let  req   = { Request.empty with
+      let  req   =
-                       userId     = usrId
+        { Request.empty with
-                       enteredOn  = now
+            userId     = usrId
-                       showAfter  = Ticks 0L
+            enteredOn  = now
-                       recurType  = Recurrence.fromString r.recurType
+            showAfter  = Ticks 0L
-                       recurCount = r.recurCount
+            recurType  = Recurrence.fromString (match form.recurInterval with Some x -> x | _ -> "Immediate")
-                       history    = [
+            recurCount = defaultArg form.recurCount (int16 0)
-                         { asOf   = now
+            history    = [
-                           status = Created
+              { asOf   = now
-                           text   = Some r.requestText
+                status = Created
-                           }      
+                text   = Some form.requestText
-                         ]
+                }      
-                     }
+              ]
+          }
       Data.addRequest req db
       do! db.saveChanges ()
-      match! Data.tryJournalById req.id usrId db with
+      return! (withHxRedirect "/journal" >=> createdAt (RequestId.toString req.id |> sprintf "/request/%s")) next ctx
-      | Some req -> return! (setStatusCode 201 >=> json req) next ctx
+      }
+  
+  /// Update a prayer request
+  let private updateRequest (form : Models.Request) : HttpHandler =
+    fun next ctx -> Ply.task {
+      let  db    = db ctx
+      let  usrId = userId ctx
+      match! Data.tryJournalById (RequestId.ofString form.id) usrId db with
+      | Some req ->
+          // TODO: Update recurrence if changed
+          let text =
+            match form.requestText.Trim () = req.text with
+            | true -> None
+            | false -> form.requestText.Trim () |> Some
+          do! Data.addHistory req.requestId usrId
+                { asOf = jsNow (); status = (Option.get >> RequestAction.fromString) form.status; text = text } db
+          return! setStatusCode 200 next ctx
       | None -> return! Error.notFound next ctx
       }
 
+  /// POST /request
+  let save : HttpHandler =
+    authorize
+    >=> fun next ctx -> task {
+      let! form = ctx.BindModelAsync<Models.Request> ()
+      let  func = match form.id with "new" -> addRequest | _ -> updateRequest
+      return! func form next ctx
+      }
+
   /// POST /api/request/[req-id]/history
   let addHistory requestId : HttpHandler =
     authorize
@@ -398,22 +453,32 @@ open Giraffe.EndpointRouting
 
 /// The routes for myPrayerJournal
 let routes =
-  [ route "/" Home.home
+  [ GET_HEAD [ route "/" Home.home ]
     subRoute "/components/" [
-      route "journal-items" Components.journalItems
+      GET_HEAD [
-      route "nav-items"     Components.navItems
+        route "journal-items" Components.journalItems
+        route "nav-items"     Components.navItems
+        ]
       ]
-    route "/journal" Journal.journal
+    GET_HEAD [ route "/journal" Journal.journal ]
     subRoute "/legal/" [
-      route "privacy-policy"   Legal.privacyPolicy
+      GET_HEAD [
-      route "terms-of-service" Legal.termsOfService
+        route "privacy-policy"   Legal.privacyPolicy
+        route "terms-of-service" Legal.termsOfService
+        ]
       ]
     subRoute "/request" [
-      route "s/active"   Request.active
+      GET_HEAD [
-      route "s/answered" Request.answered
+        route  "s/active"   Request.active
-      routef "/%s/full"  Request.getFull
+        route  "s/answered" Request.answered
+        routef "/%s/full"   Request.getFull
+        routef "/%s/edit"   Request.edit
+        ]
+      POST [
+        route  "/request" Request.save
+        ]
       ]
-    route "/user/log-on" Home.logOn
+    GET_HEAD [ route "/user/log-on" Home.logOn ]
     subRoute "/api/" [
       GET [
         subRoute "request" [
@@ -430,7 +495,6 @@ let routes =
         ]
       POST [
         subRoute "request" [
-          route  ""            Request.add
           routef "/%s/history" Request.addHistory
           routef "/%s/note"    Request.addNote
           ]

src/MyPrayerJournal/Server/Views.fs

@@ -418,14 +418,14 @@ module Request =
         ]
       div [ _class "form-floating mb-3" ] [
         textarea [
-          _id          "request_text"
+          _id          "requestText"
-          _name        "request_text"
+          _name        "requestText"
           _class       "form-control"
           _style       "min-height: 4rem;"
           _placeholder "Enter the text of the request"
           _autofocus;  _required
           ] [ str req.text ]
-        label [ _for "request_text" ] [ str "Prayer Request" ]
+        label [ _for "requestText" ] [ str "Prayer Request" ]
         ]
       br []
       match isNew with