WIP on journal

This commit is contained in:
Daniel J. Summers 2021-10-05 18:46:20 -04:00
parent 765636ee88
commit b74b4a7e65
6 changed files with 139 additions and 123 deletions

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -27,7 +27,6 @@ module Error =
[<AutoOpen>]
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)
[<CLIMutable>]
type HistoryEntry = {
/// The status of the history update
status : string
/// The text of the update
updateText : string option
}
/// An additional note
[<CLIMutable>]
type NoteEntry = {
@ -126,15 +110,6 @@ module Models =
notes : string
}
/// Recurrence update
[<CLIMutable>]
type Recurrence = {
/// The recurrence type
recurType : string
/// The recurrence cound
recurCount : int16
}
/// A prayer request
[<CLIMutable>]
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<Models.HistoryEntry> ()
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<Models.NoteEntry> ()
@ -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<Models.SnoozeUntil> ()
@ -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<Models.Recurrence> ()
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
]
]

View File

@ -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 "&rsquo;s Prayer Journal" ]
@ -272,7 +306,15 @@ module Journal =
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"
]
| 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 [] [

View File

@ -41,6 +41,9 @@ form {
position: sticky;
bottom: 0;
}
.request-text {
white-space: pre-line
}
footer {
border-top: solid 1px lightgray;