src/MyPrayerJournal/Server/Data.fs

@@ -99,12 +99,14 @@ module Startup =
 [<AutoOpen>]
 module private Helpers =
 
-  /// Async wrapper around a LiteDB query that returns multiple results
+  open System.Linq
-  let doListQuery<'T> (q : ILiteQueryable<'T>) =
-    q.ToList () |> Task.FromResult
 
-  /// Async wrapper around a LiteDB query that returns 0 or 1 results
+  /// Convert a sequence to a list asynchronously (used for LiteDB IO)
-  let doSingleQuery<'T> (q : ILiteQueryable<'T>) =
+  let toListAsync<'T> (q : 'T seq) =
+    (q.ToList >> Task.FromResult) ()
+
+  /// Convert a sequence to a list asynchronously (used for LiteDB IO)
+  let firstAsync<'T> (q : 'T seq) =
     q.FirstOrDefault () |> Task.FromResult
 
   /// Async wrapper around a request update
@@ -142,8 +144,8 @@ module private Helpers =
 
 /// Retrieve a request, including its history and notes, by its ID and user ID
 let tryFullRequestById reqId userId (db : LiteDatabase) = task {
-  let! req = doSingleQuery (db.requests.Query().Where (fun it -> it.id = reqId && it.userId = userId))
+  let! req = db.requests.Find (Query.EQ ("_id", RequestId.toString reqId |> BsonValue)) |> firstAsync
-  return match box req with null -> None | _ -> Some req
+  return match box req with null -> None | _ when req.userId = userId -> Some req | _ -> None
   }
 
 /// Add a history entry
@@ -166,7 +168,7 @@ let addRequest (req : Request) (db : LiteDatabase) =
 
 /// Retrieve all answered requests for the given user
 let answeredRequests userId (db : LiteDatabase) = task {
-  let! reqs = doListQuery (db.requests.Query().Where(fun req -> req.userId = userId))
+  let! reqs = db.requests.Find (Query.EQ ("userId", UserId.toString userId |> BsonValue)) |> toListAsync
   return
     reqs
     |> Seq.map toJournalFull
@@ -177,7 +179,7 @@ let answeredRequests userId (db : LiteDatabase) = task {
   
 /// Retrieve the user's current journal
 let journalByUserId userId (db : LiteDatabase) = task {
-  let! jrnl = doListQuery (db.requests.Query().Where(fun req -> req.userId = userId))
+  let! jrnl = db.requests.Find (Query.EQ ("userId", UserId.toString userId |> BsonValue)) |> toListAsync
   return
     jrnl
     |> Seq.map toJournalLite

src/MyPrayerJournal/Server/Handlers.fs

@@ -61,7 +61,6 @@ module Error =
 open Cuid
 open LiteDB
 open System.Security.Claims
-open Microsoft.Extensions.Logging
 
 /// Handler helpers
 [<AutoOpen>]
@@ -188,7 +187,6 @@ module Components =
     authorize
     >=> fun next ctx -> task {
       let! jrnl = Data.journalByUserId (userId ctx) (db ctx)
-      do! System.Threading.Tasks.Task.Delay (TimeSpan.FromSeconds 5.)
       return! renderComponent [ Views.Journal.journalItems jrnl ] next ctx
       }
 
@@ -201,19 +199,11 @@ module Home =
     withMenuRefresh >=> partialIfNotRefresh Views.Home.home
 
 
-/// /api/journal and /journal URLs
+/// /journal URL
 module Journal =
   
-  /// GET /api/journal
-  let journal : HttpHandler =
-    authorize
-    >=> fun next ctx -> task {
-      let! jrnl  = Data.journalByUserId (userId ctx) (db ctx)
-      return! json jrnl next ctx
-      }
-  
   // GET /journal
-  let journalPage : HttpHandler =
+  let journal : HttpHandler =
     authorize
     >=> withMenuRefresh
     >=> fun next ctx -> task {
@@ -222,18 +212,19 @@ module Journal =
     }
 
 
-/// Legalese
+/// /legal URLs
 module Legal =
   
   // GET /legal/privacy-policy
   let privacyPolicy : HttpHandler =
     withMenuRefresh >=> partialIfNotRefresh Views.Legal.privacyPolicy
   
+  // GET /legal/terms-of-service
   let termsOfService : HttpHandler =
     withMenuRefresh >=> partialIfNotRefresh Views.Legal.termsOfService
 
 
-/// /api/request URLs
+/// /api/request and /request(s) URLs
 module Request =
   
   /// POST /api/request
@@ -311,12 +302,22 @@ module Request =
       | None -> return! Error.notFound next ctx
       }
           
-  /// GET /api/requests/answered
+  /// GET /requests/active
+  let active : HttpHandler =
+    authorize
+    >=> withMenuRefresh
+    >=> fun next ctx -> task {
+      let! reqs = Data.journalByUserId (userId ctx) (db ctx)
+      return! partialIfNotRefresh (Views.Request.active reqs) next ctx
+      }
+  
+  /// GET /requests/answered
   let answered : HttpHandler =
     authorize
+    >=> withMenuRefresh
     >=> fun next ctx -> task {
       let! reqs = Data.answeredRequests (userId ctx) (db ctx)
-      return! json reqs next ctx
+      return! partialIfNotRefresh (Views.Request.answered reqs) next ctx
       }
   
   /// GET /api/request/[req-id]
@@ -396,6 +397,7 @@ module Request =
       | None -> return! Error.notFound next ctx
       }
 
+
 open Giraffe.EndpointRouting
 
 /// The routes for myPrayerJournal
@@ -405,16 +407,18 @@ let routes =
       route "journal-items" Components.journalItems
       route "nav-items"     Components.navItems
       ]
-    route "/journal" Journal.journalPage
+    route "/journal" Journal.journal
     subRoute "/legal/" [
       route "privacy-policy"   Legal.privacyPolicy
       route "terms-of-service" Legal.termsOfService
       ]
+    subRoute "/request" [
+      route "s/active"   Request.active
+      route "s/answered" Request.answered
+      ]
     subRoute "/api/" [
       GET [
-        route    "journal" Journal.journal
         subRoute "request" [
-          route  "s/answered" Request.answered
           routef "/%s/full"   Request.getFull
           routef "/%s/notes"  Request.getNotes
           routef "/%s"        Request.get

src/MyPrayerJournal/Server/Views.fs

@@ -4,8 +4,24 @@ open Giraffe.ViewEngine
 open Giraffe.ViewEngine.Htmx
 open System
 
-/// Target the `main` tag with boosted links
+[<AutoOpen>]
-let toMain = _hxTarget "main"
+module Helpers =
+  /// Target the `main` tag with boosted links
+  let toMain = _hxTarget "main"
+
+  /// Create a Material icon
+  let icon name = span [ _class "material-icons" ] [ str name ]
+
+  /// Create a card when there are no results found
+  let noResults heading link buttonText text =
+    div [ _class "card" ] [
+      h5 [ _class "card-header"] [ str heading ]
+      div [ _class "card-body text-center" ] [
+        p [ _class "card-text" ] text
+        a [ _class "btn btn-primary"; _href link; _hxBoost; toMain ] [ str buttonText ]
+        ]
+      ]
+
 
 /// View for home page
 module Home =
@@ -227,23 +243,97 @@ module Journal =
   let journalItems items =
     match items |> List.isEmpty with
     | true ->
-        div [ _class "card no-requests" ] [
+        noResults "No Active Requests" "/request/new/edit" "Add a Request" [
-          h5 [ _class "card-header"] [ str "No Active Requests" ]
+          rawText "You have no requests to be shown; see the &ldquo;Active&rdquo; link above for snoozed or "
-          div [ _class "card-body text-center" ] [
+          rawText "deferred requests, and the &ldquo;Answered&rdquo; link for answered requests"
-            p [ _class "card-text" ] [
-              rawText "You have no requests to be shown; see the &ldquo;Active&rdquo; link above for snoozed or "
-              rawText "deferred requests, and the &ldquo;Answered&rdquo; link for answered requests"
-              ]
-            a [
-              _class "btn btn-primary"
-              _href  "/request/new/edit"
-              _hxBoost; toMain
-              ] [ str "Add a Request" ]
-            ]
           ]
     | false -> p [] [ str "There are requests" ]
 
 
+/// Views for request pages and components
+module Request =
+
+  /// Create a request within the list
+  let reqListItem req =
+    let jsNow      = int64 (DateTime.UtcNow - DateTime.UnixEpoch).TotalMilliseconds
+    let reqId      = RequestId.toString req.requestId
+    let isAnswered = req.lastStatus = Answered
+    let isSnoozed  = Ticks.toLong req.snoozedUntil > jsNow
+    let isPending  = (not isSnoozed) && Ticks.toLong req.showAfter > jsNow
+    let btnClass   = _class "btn btn-light"
+    tr [] [
+      td [ _class "action-cell" ] [
+        div [ _class "btn-group btn-group-sm"; Accessibility._roleGroup ] [
+          a [ btnClass; _href $"/request/{reqId}/full"; _title "View Full Request" ] [ icon "description" ]
+          if not isAnswered then
+            a [ btnClass; _href $"/request/{reqId}/edit"; _title "Edit Request" ] [ icon "edit" ]
+          // TODO: these next two should use hx-patch, targeting replacement of this tr when complete
+          if isSnoozed then
+            a [ btnClass; _href $"/request/{reqId}/cancel-snooze"; _title "Cancel Snooze" ] [ icon "restore" ]
+          if isPending then
+            a [ btnClass; _href $"/request/{reqId}/show-now"; _title "Show Now" ] [ icon "restore" ]
+          ]
+        ]
+      td [] [
+        p [ _class "mpj-request-text mb-0" ] [
+          str req.text
+          if isSnoozed || isPending || isAnswered then
+            br []
+            small [ _class "text-muted" ] [
+              em [] [
+                if isSnoozed then str "Snooze expires date-from-now(value='request.snoozedUntil')"
+                if isPending then str "Request appears next date-from-now(:value='request.showAfter')"
+                if isAnswered then str "Answered date-from-now(:value='request.asOf')"
+                ]
+              ]
+          ]
+        ]
+      ]
+  
+  /// Create a list of requests
+  let reqList reqs =
+    table [ _class "table table-hover table-sm align-top" ] [
+      thead [] [
+        tr [] [
+          th [ _scope "col" ] [ str "Actions" ]
+          th [ _scope "col" ] [ str "Request" ]
+          ]
+        ]
+      reqs
+      |> List.map reqListItem
+      |> tbody []
+    ]
+  
+  /// View for Active Requests page
+  let active reqs = article [] [
+    h2 [] [ str "Active Requests" ]
+    match reqs |> List.isEmpty with
+    | true ->
+        noResults "No Active Requests" "/journal" "Return to your journal"
+          [ str "Your prayer journal has no active requests" ]
+    | false -> reqList reqs
+    ]
+
+  /// View for Answered Requests page
+  let answered reqs = article [] [
+    h2 [] [ str "Answered Requests" ]
+    match reqs |> List.isEmpty with
+    | true ->
+        noResults "No Active Requests" "/journal" "Return to your journal" [
+          rawText "Your prayer journal has no answered requests; once you have marked one as &ldquo;Answered&rdquo;, "
+          str "it will appear here"
+          ]
+    | false -> reqList reqs
+    ]
+
+  /// View for Snoozed Requests page
+  let snoozed reqs = article [] [
+    h2 [] [ str "Snoozed Requests" ]
+    reqList reqs
+    ]
+
+
+
 /// Layout views
 module Layout =
   
@@ -255,7 +345,8 @@ module Layout =
         _integrity   "sha384-EVSTQN3/azprG1Anm3QDgpJLIm9Nao0Yz1ztcQTwFspd3yD65VohhpuuCOmLASjC"
         _crossorigin "anonymous"
         ]
-      link [ _href "/style/style.css"; _rel  "stylesheet" ]
+      link [ _href "https://fonts.googleapis.com/icon?family=Material+Icons"; _rel "stylesheet" ]
+      link [ _href "/style/style.css"; _rel "stylesheet" ]
       script [
         _src         "https://unpkg.com/htmx.org@1.5.0"
         _integrity   "sha384-oGA+prIp5Vchu6we2YkI51UtVzN9Jpx2Z7PnR1I78PnZlN8LkrCT4lqqqmDkyrvI"

src/MyPrayerJournal/Server/wwwroot/style/style.css

@@ -26,6 +26,9 @@ nav .j {
 .navbar-nav .is-active-route {
   background-color: rgba(255, 255, 255, .2);
 }
+.action-cell .material-icons {
+  font-size: 1.1rem ;
+}
 
 footer {
   border-top: solid 1px lightgray;