src/MyPrayerJournal/Server/Dates.fs

@@ -0,0 +1,76 @@
+/// Date formatting helpers
+//  Many thanks to date-fns (https://date-fns.org) for this logic
+module MyPrayerJournal.Dates
+
+
+type internal FormatDistanceToken =
+| LessThanXMinutes
+| XMinutes
+| AboutXHours
+| XHours
+| XDays
+| AboutXWeeks
+| XWeeks
+| AboutXMonths
+| XMonths
+| AboutXYears
+| XYears
+| OverXYears
+| AlmostXYears
+
+let internal locales =
+  let format = PrintfFormat<int -> string, unit, string, string>
+  Map.ofList [
+    "en-US", Map.ofList [
+      LessThanXMinutes, ("less than a minute", format "less than %i minutes")
+      XMinutes,         ("a minute",           format "%i minutes")
+      AboutXHours,      ("about an hour",       format "about %i hours")
+      XHours,           ("an hour",             format "%i hours")
+      XDays,            ("a day",              format "%i days")
+      AboutXWeeks,      ("about a week",       format "about %i weeks")
+      XWeeks,           ("a week",             format "%i weeks")
+      AboutXMonths,     ("about a month",      format "about %i months")
+      XMonths,          ("a month",            format "%i months")
+      AboutXYears,      ("about a year",       format "about %i years")
+      XYears,           ("a year",             format "%i years")
+      OverXYears,       ("over a year",        format "over %i years")
+      AlmostXYears,     ("almost a year",      format "almost %i years")
+    ]
+  ]
+
+let aDay          =  1_440.
+let almostTwoDays =  2_520.
+let aMonth        = 43_200.
+let twoMonths     = 86_400.
+
+open System
+
+/// Convert from a JavaScript "ticks" value to a date/time
+let fromJs ticks = DateTime.UnixEpoch + TimeSpan.FromTicks (ticks * 10_000L)
+
+let formatDistance (startDate : DateTime) (endDate : DateTime) =
+  let format (token, number) locale =
+    let labels = locales |> Map.find locale
+    match number with 1 -> fst labels.[token] | _ -> sprintf (snd labels.[token]) number
+  let round (it : float) = Math.Round it |> int
+
+  let diff        = startDate - endDate
+  let formatToken =
+    let months = diff.TotalMinutes / aMonth |> round
+    let years  = months / 12
+    match true with
+    | _ when diff.TotalMinutes = 0. -> LessThanXMinutes, 1
+    | _ when diff.TotalMinutes < 45. -> XMinutes, round diff.TotalMinutes
+    | _ when diff.TotalMinutes < 90. -> AboutXHours, 1
+    | _ when diff.TotalMinutes < aDay -> AboutXHours, round (diff.TotalMinutes / 60.)
+    | _ when diff.TotalMinutes < almostTwoDays -> XDays, 1
+    | _ when diff.TotalMinutes < aMonth -> XDays, round (diff.TotalMinutes / aDay)
+    | _ when diff.TotalMinutes < twoMonths -> AboutXMonths, round (diff.TotalMinutes / aMonth)
+    | _ when months < 12 -> XMonths, round (diff.TotalMinutes / aMonth)
+    | _ when months % 12 < 3 -> AboutXYears, years
+    | _ when months % 12 < 9 -> OverXYears, years
+    | _ -> AlmostXYears, years + 1
+  
+  let words = format formatToken "en-US"
+  match startDate > endDate with true -> $"{words} ago" | false -> $"in {words}"
+

src/MyPrayerJournal/Server/Domain.fs

@@ -81,24 +81,6 @@ type RequestAction =
   | Updated
   | Answered
 
-/// Functions to manipulate request actions
-module RequestAction =
-  /// Create a string representation of an action
-  let toString =
-    function
-    | Created  -> "Created"
-    | Prayed   -> "Prayed"
-    | Updated  -> "Updated"
-    | Answered -> "Answered"
-  /// Create a RequestAction from a string
-  let fromString =
-    function
-    | "Created"  -> Created
-    | "Prayed"   -> Prayed
-    | "Updated"  -> Updated
-    | "Answered" -> Answered
-    | it         -> invalidOp $"Bad request action {it}"
-
 
 /// History is a record of action taken on a prayer request, including updates to its text
 [<CLIMutable; NoComparison; NoEquality>]
@@ -183,3 +165,28 @@ type JournalRequest =
     /// Note entries for the request
     notes        : Note list
   }
+
+
+/// Functions to manipulate request actions
+module RequestAction =
+  /// Create a string representation of an action
+  let toString =
+    function
+    | Created  -> "Created"
+    | Prayed   -> "Prayed"
+    | Updated  -> "Updated"
+    | Answered -> "Answered"
+  /// Create a RequestAction from a string
+  let fromString =
+    function
+    | "Created"  -> Created
+    | "Prayed"   -> Prayed
+    | "Updated"  -> Updated
+    | "Answered" -> Answered
+    | it         -> invalidOp $"Bad request action {it}"
+  /// Determine if a history's status is `Created`
+  let isCreated hist = hist.status = Created
+  /// Determine if a history's status is `Prayed`
+  let isPrayed hist = hist.status = Prayed
+  /// Determine if a history's status is `Answered`
+  let isAnswered hist = hist.status = Answered

src/MyPrayerJournal/Server/Handlers.fs

@@ -329,12 +329,13 @@ module Request =
       | None -> return! Error.notFound next ctx
       }
   
-  /// GET /api/request/[req-id]/full
+  /// GET /request/[req-id]/full
   let getFull requestId : HttpHandler =
     authorize
+    >=> withMenuRefresh
     >=> fun next ctx -> task {
       match! Data.tryFullRequestById (toReqId requestId) (userId ctx) (db ctx) with
-      | Some req -> return! json req next ctx
+      | Some req -> return! partialIfNotRefresh (Views.Request.full req) next ctx
       | None -> return! Error.notFound next ctx
       }
   
@@ -415,11 +416,11 @@ let routes =
     subRoute "/request" [
       route "s/active"   Request.active
       route "s/answered" Request.answered
+      routef "/%s/full"  Request.getFull
       ]
     subRoute "/api/" [
       GET [
         subRoute "request" [
-          routef "/%s/full"   Request.getFull
           routef "/%s/notes"  Request.getNotes
           routef "/%s"        Request.get
           ]

src/MyPrayerJournal/Server/MyPrayerJournal.Server.fsproj

@@ -8,6 +8,7 @@
     <Compile Include="Htmx.fs" />
     <Compile Include="Domain.fs" />
     <Compile Include="Data.fs" />
+    <Compile Include="Dates.fs" />
     <Compile Include="Views.fs" />
     <Compile Include="Handlers.fs" />
     <Compile Include="Program.fs" />

src/MyPrayerJournal/Server/ViewEngine.Htmx.fs

@@ -112,7 +112,7 @@ module HtmxAttrs =
   /// Shows a prompt before submitting a request
   let _hxPrompt     = attr "hx-prompt"
   /// Pushes the URL into the location bar, creating a new history entry
-  let _hxPushUrl    = attr "hx-push-url"
+  let _hxPushUrl    = flag "hx-push-url"
   /// Issues a PUT to the specified URL
   let _hxPut        = attr "hx-put"
   /// Configures various aspects of the request

src/MyPrayerJournal/Server/Views.fs

@@ -6,8 +6,9 @@ open System
 
 [<AutoOpen>]
 module Helpers =
-  /// Target the `main` tag with boosted links
+  
-  let toMain = _hxTarget "main"
+  /// Create a link that targets the `main` element and pushes a URL to history
+  let pageLink href attrs = a (attrs |> List.append [ _href href; _hxBoost; _hxTarget "main"; _hxPushUrl ])
 
   /// Create a Material icon
   let icon name = span [ _class "material-icons" ] [ str name ]
@@ -18,9 +19,17 @@ module Helpers =
       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 ]
+        pageLink link [ _class "btn btn-primary" ] [ str buttonText ]
         ]
       ]
+  
+  /// Convert `Ticks` to `DateTime`
+  let fromJs = Ticks.toLong >> Dates.fromJs
+
+  /// Create a date with a span tag, displaying the relative date with the full date/time in the tooltip
+  let relativeDate jsDate =
+    let date = fromJs jsDate
+    span [ _title (date.ToString "f") ] [ Dates.formatDistance DateTime.Now date |> str ]
 
 
 /// View for home page
@@ -144,7 +153,7 @@ module Legal =
           str "myPrayerJournal is a service that allows individuals to enter and amend their prayer requests. It "
           str "requires no registration by itself, but access is granted based on a successful login with an external "
           str "identity provider. See "
-          a [ _href "/legal/privacy-policy"; _hxBoost; toMain ] [ str "our privacy policy" ]
+          pageLink "/legal/privacy-policy" [] [ str "our privacy policy" ]
           str " for details on how that information is accessed and stored."
           ]
         h3 [] [ str "3. Third Party Services" ]
@@ -173,7 +182,7 @@ module Legal =
         hr []
         p [ _class "card-text" ] [
           str "You may also wish to review our "
-          a [ _href "/legal/privacy-policy"; _hxBoost; toMain ] [ str "privacy policy" ]
+          pageLink "/legal/privacy-policy" [] [ str "privacy policy" ]
           str " to learn how we handle your data."
           ]
         ]
@@ -188,7 +197,7 @@ module Navigation =
   let navBar =
     nav [ _class "navbar navbar-dark" ] [
       div [ _class "container-fluid" ] [
-        a [ _href "/"; _class "navbar-brand"; _hxBoost; toMain ] [
+        pageLink "/" [ _class "navbar-brand" ] [
           span [ _class "m" ] [ str "my" ]
           span [ _class "p" ] [ str "Prayer" ]
           span [ _class "j" ] [ str "Journal" ]
@@ -208,17 +217,13 @@ module Navigation =
       match isAuthenticated with
       | true ->
           let currUrl = match url with Some u -> (u.PathAndQuery.Split '?').[0] | None -> ""
-          let attrs (matchUrl : string) =
+          let navLink (matchUrl : string) =
-            [ _href matchUrl
+            match currUrl.StartsWith matchUrl with true -> [ _class "is-active-route" ] | false -> []
-              match currUrl.StartsWith matchUrl with
+            |> pageLink matchUrl
-              | true -> _class "is-active-route"
+          li [ _class "nav-item" ] [ navLink "/journal" [ str "Journal" ] ]
-              | false -> ()
+          li [ _class "nav-item" ] [ navLink "/requests/active" [ str "Active" ] ]
-              _hxBoost; toMain
+          if hasSnoozed then li [ _class "nav-item" ] [ navLink "/requests/snoozed" [ str "Snoozed" ] ]
-              ]
+          li [ _class "nav-item" ] [ navLink "/requests/answered" [ str "Answered" ] ]
-          li [ _class "nav-item" ] [ a (attrs "/journal") [ str "Journal" ] ]
-          li [ _class "nav-item" ] [ a (attrs "/requests/active") [ str "Active" ] ]
-          if hasSnoozed then li [ _class "nav-item" ] [ a (attrs "/requests/snoozed") [ str "Snoozed" ] ]
-          li [ _class "nav-item" ] [ a (attrs "/requests/answered") [ str "Answered" ] ]
           li [ _class "nav-item" ] [ a [ _href "/user/log-off"; _onclick "mpj.logOff(event)" ] [ str "Log Off" ] ]
       | false -> li [ _class "nav-item"] [ a [ _href "/user/log-on"; _onclick "mpj.logOn(event)"] [ str "Log On" ] ]
       li [ _class "nav-item" ] [ a [ _href "https://docs.prayerjournal.me"; _target "_blank" ] [ str "Docs" ] ]
@@ -264,14 +269,14 @@ module Request =
     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" ]
+          pageLink $"/request/{reqId}/full" [ btnClass; _title "View Full Request" ] [ icon "description" ]
           if not isAnswered then
-            a [ btnClass; _href $"/request/{reqId}/edit"; _title "Edit Request" ] [ icon "edit" ]
+            pageLink $"/request/{reqId}/edit" [ btnClass; _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" ]
+            pageLink $"/request/{reqId}/cancel-snooze" [ btnClass; _title "Cancel Snooze" ] [ icon "restore" ]
           if isPending then
-            a [ btnClass; _href $"/request/{reqId}/show-now"; _title "Show Now" ] [ icon "restore" ]
+            pageLink $"/request/{reqId}/show-now" [ btnClass; _title "Show Now" ] [ icon "restore" ]
           ]
         ]
       td [] [
@@ -281,9 +286,15 @@ module Request =
             br []
             small [ _class "text-muted" ] [
               em [] [
-                if isSnoozed then str "Snooze expires date-from-now(value='request.snoozedUntil')"
+                if isSnoozed then
-                if isPending then str "Request appears next date-from-now(:value='request.showAfter')"
+                  str "Snooze expires "
-                if isAnswered then str "Answered date-from-now(:value='request.asOf')"
+                  relativeDate req.snoozedUntil
+                if isPending then
+                  str "Request appears next "
+                  relativeDate req.showAfter
+                if isAnswered then
+                  str "Answered "
+                  relativeDate req.asOf
                 ]
               ]
           ]
@@ -305,7 +316,7 @@ module Request =
     ]
   
   /// View for Active Requests page
-  let active reqs = article [] [
+  let active reqs = article [ _class "container mt-3" ] [
     h2 [] [ str "Active Requests" ]
     match reqs |> List.isEmpty with
     | true ->
@@ -315,7 +326,7 @@ module Request =
     ]
 
   /// View for Answered Requests page
-  let answered reqs = article [] [
+  let answered reqs = article [ _class "container mt-3" ] [
     h2 [] [ str "Answered Requests" ]
     match reqs |> List.isEmpty with
     | true ->
@@ -327,11 +338,69 @@ module Request =
     ]
 
   /// View for Snoozed Requests page
-  let snoozed reqs = article [] [
+  let snoozed reqs = article [ _class "container mt-3" ] [
     h2 [] [ str "Snoozed Requests" ]
     reqList reqs
     ]
 
+  /// View for Full Request page
+  let full (req : Request) =
+    let answered =
+      req.history
+      |> List.filter RequestAction.isAnswered
+      |> List.tryHead
+      |> Option.map (fun x -> x.asOf)
+    let prayed = req.history |> List.filter RequestAction.isPrayed |> List.length
+    let daysOpen =
+      let asOf = answered |> Option.map fromJs |> Option.defaultValue DateTime.Now
+      (asOf - fromJs (req.history |> List.filter RequestAction.isCreated |> List.head).asOf).TotalDays |> int
+    let lastText =
+      req.history
+      |> List.filter (fun h -> Option.isSome h.text)
+      |> List.sortByDescending (fun h -> Ticks.toLong h.asOf)
+      |> List.map (fun h -> Option.get h.text)
+      |> List.head
+    // The history log including notes (and excluding the final entry for answered requests)
+    let log =
+      let toDisp (h : History) = {| asOf = fromJs h.asOf; text = h.text; status = RequestAction.toString h.status |}
+      let all =
+        req.notes
+        |> List.map (fun n -> {| asOf = fromJs n.asOf; text = Some n.notes; status = "Notes" |})
+        |> List.append (req.history |> List.map toDisp)
+        |> List.sortByDescending (fun it -> it.asOf)
+      // Skip the first entry for answered requests; that info is already displayed
+      match answered with Some _ -> all |> List.skip 1 | None -> all
+    article [ _class "container mt-3" ] [
+      div [_class "card" ] [
+        h5 [ _class "card-header" ] [ str "Full Prayer Request" ]
+        div [ _class "card-body" ] [
+          h6 [ _class "card-subtitle text-muted mb-2"] [
+            match answered with
+            | Some ticks ->
+                str "Answered "
+                (fromJs ticks).ToString "D" |> str
+                str " ("
+                relativeDate ticks
+                rawText ") &bull; "
+            | None -> ()
+            sprintf "Prayed %i times &bull; Open %i days" prayed daysOpen |> rawText
+            ]
+          p [ _class "card-text" ] [ str lastText ]
+          ]
+        log
+        |> List.map (fun it -> li [ _class "list-group-item" ] [
+          p [ _class "m-0" ] [
+            str it.status
+            rawText "&nbsp; "
+            small [] [ em [] [ it.asOf.ToString "D" |> str ] ]
+            ]
+          match it.text with
+          | Some txt -> p [ _class "mt-2 mb-0" ] [ str txt ]
+          | None -> ()
+        ])
+        |> ul [ _class "list-group list-group-flush" ]
+        ]
+      ]
 
 
 /// Layout views
@@ -355,15 +424,15 @@ module Layout =
       ]
 
   let htmlFoot =
-    footer [ _class "container-fluid"; _hxBoost; toMain ] [
+    footer [ _class "container-fluid" ] [
       p [ _class "text-muted text-end" ] [
         str "myPrayerJournal v3"
         br []
         em [] [
           small [] [
-            a [ _href "/legal/privacy-policy" ] [ str "Privacy Policy" ]
+            pageLink "/legal/privacy-policy" [] [ str "Privacy Policy" ]
             rawText " &bull; "
-            a [ _href "/legal/terms-of-service" ] [ str "Terms of Service" ]
+            pageLink "/legal/terms-of-service" [] [ str "Terms of Service" ]
             rawText " &bull; "
             a [ _href "https://github.com/bit-badger/myprayerjournal"; _target "_blank" ] [ str "Developed" ]
             str " and hosted by "