From b74b4a7e6568fa052e72faf1a08c6c179ba9ebdd Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Tue, 5 Oct 2021 18:46:20 -0400 Subject: [PATCH] WIP on journal --- src/MyPrayerJournal/Server/Data.fs | 4 +- src/MyPrayerJournal/Server/Dates.fs | 23 +-- src/MyPrayerJournal/Server/Domain.fs | 4 +- src/MyPrayerJournal/Server/Handlers.fs | 136 +++++++----------- src/MyPrayerJournal/Server/Views.fs | 92 ++++++++---- .../Server/wwwroot/style/style.css | 3 + 6 files changed, 139 insertions(+), 123 deletions(-) diff --git a/src/MyPrayerJournal/Server/Data.fs b/src/MyPrayerJournal/Server/Data.fs index 9b38669..3538f07 100644 --- a/src/MyPrayerJournal/Server/Data.fs +++ b/src/MyPrayerJournal/Server/Data.fs @@ -37,7 +37,7 @@ module Mapping = /// Map a BSON document to a history entry let historyFromBson (doc : BsonValue) = { asOf = Ticks doc.["asOf"].AsInt64 - status = RequestAction.fromString doc.["status"].AsString + status = RequestAction.ofString doc.["status"].AsString text = match doc.["text"].AsString with "" -> None | txt -> Some txt } @@ -75,7 +75,7 @@ module Mapping = userId = UserId doc.["userId"].AsString snoozedUntil = Ticks doc.["snoozedUntil"].AsInt64 showAfter = Ticks doc.["showAfter"].AsInt64 - recurType = Recurrence.fromString doc.["recurType"].AsString + recurType = Recurrence.ofString doc.["recurType"].AsString recurCount = int16 doc.["recurCount"].AsInt32 history = doc.["history"].AsArray |> Seq.map historyFromBson |> List.ofSeq notes = doc.["notes"].AsArray |> Seq.map noteFromBson |> List.ofSeq diff --git a/src/MyPrayerJournal/Server/Dates.fs b/src/MyPrayerJournal/Server/Dates.fs index 6a6a940..1198ce2 100644 --- a/src/MyPrayerJournal/Server/Dates.fs +++ b/src/MyPrayerJournal/Server/Dates.fs @@ -24,8 +24,8 @@ let internal locales = "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") + 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") @@ -55,18 +55,19 @@ let formatDistance (startDate : DateTime) (endDate : DateTime) = let round (it : float) = Math.Round it |> int let diff = startDate - endDate + let minutes = Math.Abs diff.TotalMinutes let formatToken = - let months = diff.TotalMinutes / aMonth |> round + let months = minutes / 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 minutes < 1. -> LessThanXMinutes, 1 + | _ when minutes < 45. -> XMinutes, round minutes + | _ when minutes < 90. -> AboutXHours, 1 + | _ when minutes < aDay -> AboutXHours, round (minutes / 60.) + | _ when minutes < almostTwoDays -> XDays, 1 + | _ when minutes < aMonth -> XDays, round (minutes / aDay) + | _ when minutes < twoMonths -> AboutXMonths, round (minutes / aMonth) + | _ when months < 12 -> XMonths, round (minutes / aMonth) | _ when months % 12 < 3 -> AboutXYears, years | _ when months % 12 < 9 -> OverXYears, years | _ -> AlmostXYears, years + 1 diff --git a/src/MyPrayerJournal/Server/Domain.fs b/src/MyPrayerJournal/Server/Domain.fs index 8873058..7a1871d 100644 --- a/src/MyPrayerJournal/Server/Domain.fs +++ b/src/MyPrayerJournal/Server/Domain.fs @@ -55,7 +55,7 @@ module Recurrence = | Days -> "Days" | Weeks -> "Weeks" /// Create a recurrence value from a string - let fromString = + let ofString = function | "Immediate" -> Immediate | "Hours" -> Hours @@ -207,7 +207,7 @@ module RequestAction = | Updated -> "Updated" | Answered -> "Answered" /// Create a RequestAction from a string - let fromString = + let ofString = function | "Created" -> Created | "Prayed" -> Prayed diff --git a/src/MyPrayerJournal/Server/Handlers.fs b/src/MyPrayerJournal/Server/Handlers.fs index 075917f..bfe38f7 100644 --- a/src/MyPrayerJournal/Server/Handlers.fs +++ b/src/MyPrayerJournal/Server/Handlers.fs @@ -27,7 +27,6 @@ module Error = [] module private Helpers = - open Cuid open LiteDB open Microsoft.AspNetCore.Http open Microsoft.Extensions.Logging @@ -52,13 +51,6 @@ module private Helpers = let userId ctx = ((user >> Option.get) ctx).Value |> UserId - /// Create a request ID from a string - let toReqId x = - match Cuid.ofString x with - | Ok cuid -> cuid - | Error msg -> invalidOp msg - |> RequestId - /// Return a 201 CREATED response let created = setStatusCode 201 @@ -107,18 +99,10 @@ module private Helpers = let withSuccessMessage : string -> HttpHandler = sprintf "success|||%s" >> setHttpHeader "X-Toast" + /// Strongly-typed models for post requests module Models = - /// A history entry addition (AKA request update) - [] - type HistoryEntry = { - /// The status of the history update - status : string - /// The text of the update - updateText : string option - } - /// An additional note [] type NoteEntry = { @@ -126,15 +110,6 @@ module Models = notes : string } - /// Recurrence update - [] - type Recurrence = { - /// The recurrence type - recurType : string - /// The recurrence cound - recurCount : int16 - } - /// A prayer request [] type Request = { @@ -177,8 +152,10 @@ module Components = let journalItems : HttpHandler = authorize >=> fun next ctx -> task { - let! jrnl = Data.journalByUserId (userId ctx) (db ctx) - return! renderComponent [ Views.Journal.journalItems jrnl ] next ctx + let shouldShow now r = now > Ticks.toLong r.snoozedUntil && now > Ticks.toLong r.showAfter + let! jrnl = Data.journalByUserId (userId ctx) (db ctx) + let shown = jrnl |> List.filter (shouldShow ((jsNow >> Ticks.toLong) ())) + return! renderComponent [ Views.Journal.journalItems shown ] next ctx } // GET /components/request/[req-id]/edit @@ -253,33 +230,24 @@ module Ply = FSharp.Control.Tasks.Affine /// /api/request and /request(s) URLs module Request = - /// POST /api/request/[req-id]/history - let addHistory requestId : HttpHandler = + // PATCH /request/[req-id]/prayed + let prayed requestId : HttpHandler = authorize - >=> fun next ctx -> FSharp.Control.Tasks.Affine.task { + >=> fun next ctx -> task { let db = db ctx let usrId = userId ctx - let reqId = toReqId requestId + let reqId = RequestId.ofString requestId match! Data.tryRequestById reqId usrId db with | Some req -> - let! hist = ctx.BindJsonAsync () - let now = jsNow () - let act = RequestAction.fromString hist.status - do! Data.addHistory reqId usrId - { asOf = now - status = act - text = match hist.updateText with None | Some "" -> None | x -> x - } db - match act with - | Prayed -> - let nextShow = - match Recurrence.duration req.recurType with - | 0L -> 0L - | duration -> (Ticks.toLong now) + (duration * int64 req.recurCount) - do! Data.updateShowAfter reqId usrId (Ticks nextShow) db - | _ -> () + let now = jsNow () + do! Data.addHistory reqId usrId { asOf = now; status = Prayed; text = None } db + let nextShow = + match Recurrence.duration req.recurType with + | 0L -> 0L + | duration -> (Ticks.toLong now) + (duration * int64 req.recurCount) + do! Data.updateShowAfter reqId usrId (Ticks nextShow) db do! db.saveChanges () - return! created next ctx + return! (withSuccessMessage "Request marked as prayed" >=> Components.journalItems) next ctx | None -> return! Error.notFound next ctx } @@ -289,7 +257,7 @@ module Request = >=> fun next ctx -> task { let db = db ctx let usrId = userId ctx - let reqId = toReqId requestId + let reqId = RequestId.ofString requestId match! Data.tryRequestById reqId usrId db with | Some _ -> let! notes = ctx.BindJsonAsync () @@ -307,6 +275,16 @@ module Request = return! partialIfNotRefresh "Active Requests" (Views.Request.active reqs) next ctx } + /// GET /requests/snoozed + let snoozed : HttpHandler = + authorize + >=> fun next ctx -> task { + let! reqs = Data.journalByUserId (userId ctx) (db ctx) + let now = (jsNow >> Ticks.toLong) () + let snoozed = reqs |> List.filter (fun r -> Ticks.toLong r.snoozedUntil > now) + return! partialIfNotRefresh "Active Requests" (Views.Request.snoozed snoozed) next ctx + } + /// GET /requests/answered let answered : HttpHandler = authorize @@ -319,17 +297,17 @@ module Request = let get requestId : HttpHandler = authorize >=> fun next ctx -> task { - match! Data.tryJournalById (toReqId requestId) (userId ctx) (db ctx) with + match! Data.tryJournalById (RequestId.ofString requestId) (userId ctx) (db ctx) with | Some req -> return! json req next ctx | None -> return! Error.notFound next ctx } - /// GET /request/[req-id]/full + // GET /request/[req-id]/full let getFull requestId : HttpHandler = authorize >=> fun next ctx -> task { - match! Data.tryFullRequestById (toReqId requestId) (userId ctx) (db ctx) with - | Some req -> return! partialIfNotRefresh "Full Prayer Request" (Views.Request.full req) next ctx + match! Data.tryFullRequestById (RequestId.ofString requestId) (userId ctx) (db ctx) with + | Some req -> return! partialIfNotRefresh "Prayer Request" (Views.Request.full req) next ctx | None -> return! Error.notFound next ctx } @@ -337,22 +315,22 @@ module Request = let getNotes requestId : HttpHandler = authorize >=> fun next ctx -> task { - let! notes = Data.notesById (toReqId requestId) (userId ctx) (db ctx) + let! notes = Data.notesById (RequestId.ofString requestId) (userId ctx) (db ctx) return! json notes next ctx } - /// PATCH /api/request/[req-id]/show + // PATCH /request/[req-id]/show let show requestId : HttpHandler = authorize >=> fun next ctx -> task { let db = db ctx let usrId = userId ctx - let reqId = toReqId requestId + let reqId = RequestId.ofString requestId match! Data.tryRequestById reqId usrId db with | Some _ -> do! Data.updateShowAfter reqId usrId (Ticks 0L) db do! db.saveChanges () - return! setStatusCode 204 next ctx + return! (withSuccessMessage "Request now shown" >=> Components.requestItem requestId) next ctx | None -> return! Error.notFound next ctx } @@ -362,7 +340,7 @@ module Request = >=> fun next ctx -> task { let db = db ctx let usrId = userId ctx - let reqId = toReqId requestId + let reqId = RequestId.ofString requestId match! Data.tryRequestById reqId usrId db with | Some _ -> let! until = ctx.BindJsonAsync () @@ -371,30 +349,25 @@ module Request = return! setStatusCode 204 next ctx | None -> return! Error.notFound next ctx } - - /// PATCH /api/request/[req-id]/recurrence - let updateRecurrence requestId : HttpHandler = + + // PATCH /request/[req-id]/cancel-snooze + let cancelSnooze requestId : HttpHandler = authorize - >=> fun next ctx -> FSharp.Control.Tasks.Affine.task { + >=> fun next ctx -> task { let db = db ctx let usrId = userId ctx - let reqId = toReqId requestId + let reqId = RequestId.ofString requestId match! Data.tryRequestById reqId usrId db with | Some _ -> - let! recur = ctx.BindJsonAsync () - let recurrence = Recurrence.fromString recur.recurType - do! Data.updateRecurrence reqId usrId recurrence recur.recurCount db - match recurrence with - | Immediate -> do! Data.updateShowAfter reqId usrId (Ticks 0L) db - | _ -> () + do! Data.updateSnoozed reqId usrId (Ticks 0L) db do! db.saveChanges () - return! setStatusCode 204 next ctx + return! (withSuccessMessage "Request unsnoozed" >=> Components.requestItem requestId) next ctx | None -> return! Error.notFound next ctx } /// Derive a recurrence and interval from its primitive representation in the form let private parseRecurrence (form : Models.Request) = - (Recurrence.fromString (match form.recurInterval with Some x -> x | _ -> "Immediate"), + (Recurrence.ofString (match form.recurInterval with Some x -> x | _ -> "Immediate"), defaultArg form.recurCount (int16 0)) // POST /request @@ -433,7 +406,7 @@ module Request = let usrId = userId ctx match! Data.tryJournalById (RequestId.ofString form.requestId) usrId db with | Some req -> - // step 1 - update recurrence if changed + // update recurrence if changed let (recur, interval) = parseRecurrence form match recur = req.recurType && interval = req.recurCount with | true -> () @@ -442,20 +415,18 @@ module Request = match recur with | Immediate -> do! Data.updateShowAfter req.requestId usrId (Ticks 0L) db | _ -> () - // step 2 - append history + // append history let upd8Text = form.requestText.Trim () let text = match upd8Text = req.text with true -> None | false -> Some upd8Text do! Data.addHistory req.requestId usrId - { asOf = jsNow (); status = (Option.get >> RequestAction.fromString) form.status; text = text } db + { asOf = jsNow (); status = (Option.get >> RequestAction.ofString) form.status; text = text } db do! db.saveChanges () - // step 3 - return updated view return! (withSuccessMessage "Prayer request updated successfully" >=> Components.requestItem (RequestId.toString req.requestId)) next ctx | None -> return! Error.notFound next ctx } - open Giraffe.EndpointRouting /// The routes for myPrayerJournal @@ -478,12 +449,16 @@ let routes = ] subRoute "/request" [ GET_HEAD [ + routef "/%s/full" Request.getFull route "s/active" Request.active route "s/answered" Request.answered - routef "/%s/full" Request.getFull + route "s/snoozed" Request.snoozed ] PATCH [ - route "" Request.update + route "" Request.update + routef "/%s/cancel-snooze" Request.cancelSnooze + routef "/%s/prayed" Request.prayed + routef "/%s/show" Request.show ] POST [ route "" Request.add @@ -499,14 +474,11 @@ let routes = ] PATCH [ subRoute "request" [ - routef "/%s/recurrence" Request.updateRecurrence - routef "/%s/show" Request.show routef "/%s/snooze" Request.snooze ] ] POST [ subRoute "request" [ - routef "/%s/history" Request.addHistory routef "/%s/note" Request.addNote ] ] diff --git a/src/MyPrayerJournal/Server/Views.fs b/src/MyPrayerJournal/Server/Views.fs index 13db1fd..765461e 100644 --- a/src/MyPrayerJournal/Server/Views.fs +++ b/src/MyPrayerJournal/Server/Views.fs @@ -1,6 +1,7 @@ module MyPrayerJournal.Views open Giraffe.ViewEngine +open Giraffe.ViewEngine.Accessibility open Giraffe.ViewEngine.Htmx open System @@ -29,7 +30,7 @@ module Helpers = /// 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 ] + span [ _title (date.ToString "f") ] [ Dates.formatDistance DateTime.UtcNow date |> str ] /// Views for home and log on pages @@ -254,6 +255,39 @@ module Navigation = /// Views for journal pages and components module Journal = + /// Display a card for this prayer request + let journalCard req = + div [ _class "col" ] [ + div [ _class "card h-100" ] [ + div [ _class "card-header p-0 text-end"; _roleToolBar ] [ + button [ + _class "btn btn-success" + _hxPatch $"/request/{RequestId.toString req.requestId}/prayed" + _title "Mark as Prayed" + ] [ icon "done" ] + // span + // md-button(@click.stop='showEdit()').md-icon-button.md-raised + // md-icon edit + // md-tooltip(md-direction='top' + // md-delay=1000) Edit Request + // md-button(@click.stop='showNotes()').md-icon-button.md-raised + // md-icon comment + // md-tooltip(md-direction='top' + // md-delay=1000) Add Notes + // md-button(@click.stop='snooze()').md-icon-button.md-raised + // md-icon schedule + // md-tooltip(md-direction='top' + // md-delay=1000) Snooze Request + ] + div [ _class "card-body" ] [ + p [ _class "request-text" ] [ str req.text ] + ] + div [ _class "card-footer text-end text-muted px-1 py-0" ] [ + em [] [ str "last activity "; relativeDate req.asOf ] + ] + ] + ] + /// The journal loading page let journal user = article [ _class "container-fluid mt-3" ] [ h2 [ _class "pb-3" ] [ str user; rawText "’s Prayer Journal" ] @@ -272,7 +306,15 @@ module Journal = rawText "You have no requests to be shown; see the “Active” link above for snoozed or " rawText "deferred requests, and the “Answered” link for answered requests" ] - | false -> p [] [ str "There are requests" ] + | false -> + items + |> List.map journalCard + |> section [ + _class "row row-cols-1 row-cols-md-2 row-cols-lg-3 row-cols-xl-4 g-3" + _hxTarget "this" + _hxSwap HxSwap.OuterHtml + ] + /// Views for request pages and components @@ -292,30 +334,29 @@ module Request = _hxSwap HxSwap.OuterHtml ] [ pageLink $"/request/{reqId}/full" [ btnClass; _title "View Full Request" ] [ icon "description" ] - if not isAnswered then - button [ btnClass; _hxGet $"/components/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 - pageLink $"/request/{reqId}/cancel-snooze" [ btnClass; _title "Cancel Snooze" ] [ icon "restore" ] - if isPending then - pageLink $"/request/{reqId}/show-now" [ btnClass; _title "Show Now" ] [ icon "restore" ] - p [ _class "mpj-request-text mb-0" ] [ + match isAnswered with + | true -> () + | false -> + button [ btnClass; _hxGet $"/components/request/{reqId}/edit"; _title "Edit Request" ] [ icon "edit" ] + match () with + | _ when isSnoozed -> + button [ btnClass; _hxPatch $"/request/{reqId}/cancel-snooze"; _title "Cancel Snooze" ] [ icon "restore" ] + | _ when isPending -> + button [ btnClass; _hxPatch $"/request/{reqId}/show"; _title "Show Now" ] [ icon "restore" ] + | _ -> () + p [ _class "request-text mb-0" ] [ str req.text - if isSnoozed || isPending || isAnswered then - br [] - small [ _class "text-muted" ] [ - em [] [ - if isSnoozed then - str "Snooze expires " - relativeDate req.snoozedUntil - if isPending then - str "Request appears next " - relativeDate req.showAfter - if isAnswered then - str "Answered " - relativeDate req.asOf + match isSnoozed || isPending || isAnswered with + | true -> + br [] + small [ _class "text-muted" ] [ + match () with + | _ when isSnoozed -> [ str "Snooze expires "; relativeDate req.snoozedUntil ] + | _ when isPending -> [ str "Request appears next "; relativeDate req.showAfter ] + | _ (* isAnswered *) -> [ str "Answered "; relativeDate req.asOf ] + |> em [] ] - ] + | false -> () ] ] @@ -524,11 +565,10 @@ module Request = ] ] + /// Layout views module Layout = - open Giraffe.ViewEngine.Accessibility - /// The HTML `head` element let htmlHead pageTitle = head [] [ diff --git a/src/MyPrayerJournal/Server/wwwroot/style/style.css b/src/MyPrayerJournal/Server/wwwroot/style/style.css index 5962461..3ae0224 100644 --- a/src/MyPrayerJournal/Server/wwwroot/style/style.css +++ b/src/MyPrayerJournal/Server/wwwroot/style/style.css @@ -41,6 +41,9 @@ form { position: sticky; bottom: 0; } +.request-text { + white-space: pre-line +} footer { border-top: solid 1px lightgray;