Version 3 #67

Merged
danieljsummers merged 53 commits from version-3 into master 2021-10-26 23:39:59 +00:00
12 changed files with 137 additions and 135 deletions
Showing only changes of commit 619c94f5ed - Show all commits

View File

@ -12,10 +12,11 @@
<ItemGroup>
<PackageReference Include="FSharp.Data" Version="4.2.3" />
<PackageReference Include="LiteDB" Version="5.0.11" />
<PackageReference Include="NodaTime" Version="3.0.9" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\Api\MyPrayerJournal.Api.fsproj" />
<ProjectReference Include="..\Server\MyPrayerJournal.Server.fsproj" />
</ItemGroup>
</Project>

View File

@ -2,6 +2,7 @@
open FSharp.Data.CsvExtensions
open LiteDB
open MyPrayerJournal.Domain
open NodaTime
module Subdocs =
@ -12,8 +13,8 @@ module Subdocs =
| JsonValue.Array hist ->
hist
|> Array.map (fun h ->
{ asOf = h?asOf.AsInteger64 () |> Ticks
status = h?status.AsString () |> RequestAction.fromString
{ asOf = (h?asOf.AsInteger64 >> Instant.FromUnixTimeMilliseconds) ()
status = h?status.AsString () |> RequestAction.ofString
text = match h?text.AsString () with "" -> None | txt -> Some txt
})
|> List.ofArray
@ -24,7 +25,7 @@ module Subdocs =
| JsonValue.Array notes ->
notes
|> Array.map (fun n ->
{ asOf = n?asOf.AsInteger64 () |> Ticks
{ asOf = (n?asOf.AsInteger64 >> Instant.FromUnixTimeMilliseconds) ()
notes = n?notes.AsString ()
})
|> List.ofArray
@ -39,12 +40,12 @@ MyPrayerJournal.Data.Startup.ensureDb db
let migrated =
oldData.Rows
|> Seq.map (fun r ->
{ id = r.["@id"].Replace ("Requests/", "") |> RequestId.ofString
enteredOn = r?enteredOn.AsInteger64 () |> Ticks
{ id = r["@id"].Replace ("Requests/", "") |> RequestId.ofString
enteredOn = (r?enteredOn.AsInteger64 >> Instant.FromUnixTimeMilliseconds) ()
userId = UserId r?userId
snoozedUntil = r?snoozedUntil.AsInteger64 () |> Ticks
showAfter = r?showAfter.AsInteger64 () |> Ticks
recurType = r?recurType |> Recurrence.fromString
snoozedUntil = (r?snoozedUntil.AsInteger64 >> Instant.FromUnixTimeMilliseconds) ()
showAfter = (r?showAfter.AsInteger64 >> Instant.FromUnixTimeMilliseconds) ()
recurType = r?recurType |> Recurrence.ofString
recurCount = (r?recurCount.AsInteger >> int16) ()
history = Subdocs.history r?history
notes = Subdocs.notes r?notes

View File

@ -1,6 +1,7 @@
module MyPrayerJournal.Data
open LiteDB
open NodaTime
open System
open System.Threading.Tasks
@ -29,14 +30,14 @@ module Mapping =
/// Map a history entry to BSON
let historyToBson (hist : History) : BsonValue =
let doc = BsonDocument ()
doc["asOf"] <- Ticks.toLong hist.asOf
doc["asOf"] <- hist.asOf.ToUnixTimeMilliseconds ()
doc["status"] <- RequestAction.toString hist.status
doc["text"] <- match hist.text with Some t -> t | None -> ""
upcast doc
/// Map a BSON document to a history entry
let historyFromBson (doc : BsonValue) =
{ asOf = Ticks doc["asOf"].AsInt64
{ asOf = Instant.FromUnixTimeMilliseconds doc["asOf"].AsInt64
status = RequestAction.ofString doc["status"].AsString
text = match doc["text"].AsString with "" -> None | txt -> Some txt
}
@ -44,13 +45,13 @@ module Mapping =
/// Map a note entry to BSON
let noteToBson (note : Note) : BsonValue =
let doc = BsonDocument ()
doc["asOf"] <- Ticks.toLong note.asOf
doc["asOf"] <- note.asOf.ToUnixTimeMilliseconds ()
doc["notes"] <- note.notes
upcast doc
/// Map a BSON document to a note entry
let noteFromBson (doc : BsonValue) =
{ asOf = Ticks doc["asOf"].AsInt64
{ asOf = Instant.FromUnixTimeMilliseconds doc["asOf"].AsInt64
notes = doc["notes"].AsString
}
@ -58,10 +59,10 @@ module Mapping =
let requestToBson req : BsonValue =
let doc = BsonDocument ()
doc["_id"] <- RequestId.toString req.id
doc["enteredOn"] <- Ticks.toLong req.enteredOn
doc["enteredOn"] <- req.enteredOn.ToUnixTimeMilliseconds ()
doc["userId"] <- UserId.toString req.userId
doc["snoozedUntil"] <- Ticks.toLong req.snoozedUntil
doc["showAfter"] <- Ticks.toLong req.showAfter
doc["snoozedUntil"] <- req.snoozedUntil.ToUnixTimeMilliseconds ()
doc["showAfter"] <- req.showAfter.ToUnixTimeMilliseconds ()
doc["recurType"] <- Recurrence.toString req.recurType
doc["recurCount"] <- BsonValue req.recurCount
doc["history"] <- BsonArray (req.history |> List.map historyToBson |> Seq.ofList)
@ -71,10 +72,10 @@ module Mapping =
/// Map a BSON document to a request
let requestFromBson (doc : BsonValue) =
{ id = RequestId.ofString doc["_id"].AsString
enteredOn = Ticks doc["enteredOn"].AsInt64
enteredOn = Instant.FromUnixTimeMilliseconds doc["enteredOn"].AsInt64
userId = UserId doc["userId"].AsString
snoozedUntil = Ticks doc["snoozedUntil"].AsInt64
showAfter = Ticks doc["showAfter"].AsInt64
snoozedUntil = Instant.FromUnixTimeMilliseconds doc["snoozedUntil"].AsInt64
showAfter = Instant.FromUnixTimeMilliseconds doc["showAfter"].AsInt64
recurType = Recurrence.ofString doc["recurType"].AsString
recurCount = int16 doc["recurCount"].AsInt32
history = doc["history"].AsArray |> Seq.map historyFromBson |> List.ofSeq
@ -139,6 +140,8 @@ let addNote reqId userId note db = backgroundTask {
let addRequest (req : Request) (db : LiteDatabase) =
db.requests.Insert req |> ignore
// FIXME: make a common function here
/// Retrieve all answered requests for the given user
let answeredRequests userId (db : LiteDatabase) = backgroundTask {
let! reqs = db.requests.Find (Query.EQ ("userId", UserId.toString userId)) |> toListAsync
@ -146,7 +149,7 @@ let answeredRequests userId (db : LiteDatabase) = backgroundTask {
reqs
|> Seq.map JournalRequest.ofRequestFull
|> Seq.filter (fun it -> it.lastStatus = Answered)
|> Seq.sortByDescending (fun it -> Ticks.toLong it.asOf)
|> Seq.sortByDescending (fun it -> it.asOf)
|> List.ofSeq
}
@ -157,14 +160,14 @@ let journalByUserId userId (db : LiteDatabase) = backgroundTask {
jrnl
|> Seq.map JournalRequest.ofRequestLite
|> Seq.filter (fun it -> it.lastStatus <> Answered)
|> Seq.sortBy (fun it -> Ticks.toLong it.asOf)
|> Seq.sortBy (fun it -> it.asOf)
|> List.ofSeq
}
/// Does the user have any snoozed requests?
let hasSnoozed userId now (db : LiteDatabase) = backgroundTask {
let! jrnl = journalByUserId userId db
return jrnl |> List.exists (fun r -> Ticks.toLong r.snoozedUntil > Ticks.toLong now)
return jrnl |> List.exists (fun r -> r.snoozedUntil > now)
}
/// Retrieve a request by its ID and user ID (without notes and history)

View File

@ -2,6 +2,7 @@
// Many thanks to date-fns (https://date-fns.org) for this logic
module MyPrayerJournal.Dates
open NodaTime
type internal FormatDistanceToken =
| LessThanXMinutes
@ -48,7 +49,7 @@ 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 formatDistance (startDate : Instant) (endDate : Instant) =
let format (token, number) locale =
let labels = locales |> Map.find locale
match number with 1 -> fst labels[token] | _ -> sprintf (snd labels[token]) number

View File

@ -5,6 +5,7 @@ module MyPrayerJournal.Domain
// fsharplint:disable RecordFieldNames
open Cuid
open NodaTime
/// An identifier for a request
type RequestId =
@ -28,16 +29,6 @@ module UserId =
let toString = function UserId x -> x
/// A long integer representing seconds since the epoch
type Ticks =
| Ticks of int64
/// Functions to manipulate Ticks
module Ticks =
/// The int64 (long) representation of ticks
let toLong = function Ticks x -> x
/// How frequently a request should reappear after it is marked "Prayed"
type Recurrence =
| Immediate
@ -71,7 +62,6 @@ module Recurrence =
| Hours -> oneHour
| Days -> oneHour * 24L
| Weeks -> oneHour * 24L * 7L)
|> ( * ) 1000L
/// The action taken on a request as part of a history entry
@ -86,7 +76,7 @@ type RequestAction =
[<CLIMutable; NoComparison; NoEquality>]
type History = {
/// The time when this history entry was made
asOf : Ticks
asOf : Instant
/// The status for this history entry
status : RequestAction
/// The text of the update, if applicable
@ -97,7 +87,7 @@ type History = {
[<CLIMutable; NoComparison; NoEquality>]
type Note = {
/// The time when this note was made
asOf : Ticks
asOf : Instant
/// The text of the notes
notes : string
}
@ -108,13 +98,13 @@ type Request = {
/// The ID of the request
id : RequestId
/// The time this request was initially entered
enteredOn : Ticks
enteredOn : Instant
/// The ID of the user to whom this request belongs ("sub" from the JWT)
userId : UserId
/// The time at which this request should reappear in the user's journal by manual user choice
snoozedUntil : Ticks
snoozedUntil : Instant
/// The time at which this request should reappear in the user's journal by recurrence
showAfter : Ticks
showAfter : Instant
/// The type of recurrence for this request
recurType : Recurrence
/// How many of the recurrence intervals should occur between appearances in the journal
@ -128,10 +118,10 @@ with
/// An empty request
static member empty =
{ id = Cuid.generate () |> RequestId
enteredOn = Ticks 0L
enteredOn = Instant.MinValue
userId = UserId ""
snoozedUntil = Ticks 0L
showAfter = Ticks 0L
snoozedUntil = Instant.MinValue
showAfter = Instant.MinValue
recurType = Immediate
recurCount = 0s
history = []
@ -149,13 +139,13 @@ type JournalRequest =
/// The current text of the request
text : string
/// The last time action was taken on the request
asOf : Ticks
asOf : Instant
/// The last status for the request
lastStatus : RequestAction
/// The time that this request should reappear in the user's journal
snoozedUntil : Ticks
snoozedUntil : Instant
/// The time after which this request should reappear in the user's journal by configured recurrence
showAfter : Ticks
showAfter : Instant
/// The type of recurrence for this request
recurType : Recurrence
/// How many of the recurrence intervals should occur between appearances in the journal
@ -171,16 +161,16 @@ 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.tryHead
let hist = req.history |> List.sortByDescending (fun it -> it.asOf) |> List.tryHead
{ 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.sortByDescending (fun it -> it.asOf)
|> List.tryHead
|> Option.map (fun h -> Option.get h.text)
|> Option.defaultValue ""
asOf = match hist with Some h -> h.asOf | None -> Ticks 0L
asOf = match hist with Some h -> h.asOf | None -> Instant.MinValue
lastStatus = match hist with Some h -> h.status | None -> Created
snoozedUntil = req.snoozedUntil
showAfter = req.showAfter

View File

@ -10,6 +10,7 @@ open Microsoft.AspNetCore.Authentication
open Microsoft.AspNetCore.Http
open System
open System.Security.Claims
open NodaTime
/// Helper function to be able to split out log on
[<AutoOpen>]
@ -81,6 +82,14 @@ module private Helpers =
let userId ctx =
(user >> Option.get) ctx |> UserId
/// Get the system clock
let clock (ctx : HttpContext) =
ctx.GetService<IClock> ()
/// Get the current instant
let now ctx =
(clock ctx).GetCurrentInstant ()
/// Return a 201 CREATED response
let created =
setStatusCode 201
@ -95,14 +104,6 @@ module private Helpers =
let seeOther (url : string) =
noResponseCaching >=> setStatusCode 303 >=> setHttpHeader "Location" url
/// Convert a date/time to JS-style ticks
let toJs (date : DateTime) =
date.Subtract(DateTime (1970, 1, 1, 0, 0, 0)).TotalSeconds |> (int64 >> ( * ) 1_000L >> Ticks)
/// The "now" time in JavaScript as Ticks
let jsNow () =
toJs DateTime.UtcNow
/// Render a component result
let renderComponent nodes : HttpHandler =
noResponseCaching
@ -116,7 +117,7 @@ module private Helpers =
let pageContext (ctx : HttpContext) pageTitle content = backgroundTask {
let! hasSnoozed = backgroundTask {
match user ctx with
| Some _ -> return! Data.hasSnoozed (userId ctx) (jsNow ()) (db ctx)
| Some _ -> return! Data.hasSnoozed (userId ctx) (now ctx) (db ctx)
| None -> return false
}
return {
@ -224,6 +225,7 @@ module Models =
open MyPrayerJournal.Data.Extensions
open NodaTime.Text
/// Handlers for less-than-full-page HTML requests
module Components =
@ -232,10 +234,10 @@ module Components =
let journalItems : HttpHandler =
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask {
let shouldShow now r = now > Ticks.toLong r.snoozedUntil && now > Ticks.toLong r.showAfter
let now = now ctx
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
let shown = jrnl |> List.filter (fun it -> now > it.snoozedUntil && now > it.showAfter)
return! renderComponent [ Views.Journal.journalItems now shown ] next ctx
}
// GET /components/request-item/[req-id]
@ -243,7 +245,7 @@ module Components =
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask {
match! Data.tryJournalById (RequestId.ofString reqId) (userId ctx) (db ctx) with
| Some req -> return! renderComponent [ Views.Request.reqListItem req ] next ctx
| Some req -> return! renderComponent [ Views.Request.reqListItem (now ctx) req ] next ctx
| None -> return! Error.notFound next ctx
}
@ -257,7 +259,7 @@ module Components =
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask {
let! notes = Data.notesById (RequestId.ofString requestId) (userId ctx) (db ctx)
return! renderComponent (Views.Request.notes notes) next ctx
return! renderComponent (Views.Request.notes (now ctx) notes) next ctx
}
// GET /components/request/[req-id]/snooze
@ -321,8 +323,12 @@ module Request =
(Views.Request.edit (JournalRequest.ofRequestLite Request.empty) returnTo true) next ctx
| _ ->
match! Data.tryJournalById (RequestId.ofString requestId) (userId ctx) (db ctx) with
| Some req -> return! partial "Edit Prayer Request" (Views.Request.edit req returnTo false) next ctx
| None -> return! Error.notFound next ctx
| Some req ->
debug ctx "Found - sending view"
return! partial "Edit Prayer Request" (Views.Request.edit req returnTo false) next ctx
| None ->
debug ctx "Not found - uh oh..."
return! Error.notFound next ctx
}
// PATCH /request/[req-id]/prayed
@ -334,13 +340,13 @@ module Request =
let reqId = RequestId.ofString requestId
match! Data.tryRequestById reqId usrId db with
| Some req ->
let now = jsNow ()
let now = now ctx
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
| 0L -> Instant.MinValue
| duration -> now.Plus (Duration.FromSeconds (duration * int64 req.recurCount))
do! Data.updateShowAfter reqId usrId nextShow db
do! db.saveChanges ()
return! (withSuccessMessage "Request marked as prayed" >=> Components.journalItems) next ctx
| None -> return! Error.notFound next ctx
@ -356,7 +362,7 @@ module Request =
match! Data.tryRequestById reqId usrId db with
| Some _ ->
let! notes = ctx.BindFormAsync<Models.NoteEntry> ()
do! Data.addNote reqId usrId { asOf = jsNow (); notes = notes.notes } db
do! Data.addNote reqId usrId { asOf = now ctx; notes = notes.notes } db
do! db.saveChanges ()
return! (withSuccessMessage "Added Notes" >=> hideModal "notes" >=> created) next ctx
| None -> return! Error.notFound next ctx
@ -367,7 +373,7 @@ module Request =
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask {
let! reqs = Data.journalByUserId (userId ctx) (db ctx)
return! partial "Active Requests" (Views.Request.active reqs) next ctx
return! partial "Active Requests" (Views.Request.active (now ctx) reqs) next ctx
}
// GET /requests/snoozed
@ -375,9 +381,9 @@ module Request =
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask {
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! partial "Active Requests" (Views.Request.snoozed snoozed) next ctx
let now = now ctx
let snoozed = reqs |> List.filter (fun it -> it.snoozedUntil > now)
return! partial "Active Requests" (Views.Request.snoozed now snoozed) next ctx
}
// GET /requests/answered
@ -385,7 +391,7 @@ module Request =
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask {
let! reqs = Data.answeredRequests (userId ctx) (db ctx)
return! partial "Answered Requests" (Views.Request.answered reqs) next ctx
return! partial "Answered Requests" (Views.Request.answered (now ctx) reqs) next ctx
}
// GET /api/request/[req-id]
@ -402,7 +408,7 @@ module Request =
requiresAuthentication Error.notAuthorized
>=> fun next ctx -> backgroundTask {
match! Data.tryFullRequestById (RequestId.ofString requestId) (userId ctx) (db ctx) with
| Some req -> return! partial "Prayer Request" (Views.Request.full req) next ctx
| Some req -> return! partial "Prayer Request" (Views.Request.full (clock ctx) req) next ctx
| None -> return! Error.notFound next ctx
}
@ -415,7 +421,7 @@ module Request =
let reqId = RequestId.ofString requestId
match! Data.tryRequestById reqId usrId db with
| Some _ ->
do! Data.updateShowAfter reqId usrId (Ticks 0L) db
do! Data.updateShowAfter reqId usrId Instant.MinValue db
do! db.saveChanges ()
return! (withSuccessMessage "Request now shown" >=> Components.requestItem requestId) next ctx
| None -> return! Error.notFound next ctx
@ -431,8 +437,11 @@ module Request =
match! Data.tryRequestById reqId usrId db with
| Some _ ->
let! until = ctx.BindFormAsync<Models.SnoozeUntil> ()
let date = sprintf "%s 00:00:00" until.until |> DateTime.Parse
do! Data.updateSnoozed reqId usrId (toJs date) db
let date =
LocalDatePattern.CreateWithInvariantCulture("yyyy-MM-dd").Parse(until.until).Value
.AtStartOfDayInZone(DateTimeZone.Utc)
.ToInstant ()
do! Data.updateSnoozed reqId usrId date db
do! db.saveChanges ()
return!
(withSuccessMessage $"Request snoozed until {until.until}"
@ -450,7 +459,7 @@ module Request =
let reqId = RequestId.ofString requestId
match! Data.tryRequestById reqId usrId db with
| Some _ ->
do! Data.updateSnoozed reqId usrId (Ticks 0L) db
do! Data.updateSnoozed reqId usrId Instant.MinValue db
do! db.saveChanges ()
return! (withSuccessMessage "Request unsnoozed" >=> Components.requestItem requestId) next ctx
| None -> return! Error.notFound next ctx
@ -468,13 +477,13 @@ module Request =
let! form = ctx.BindModelAsync<Models.Request> ()
let db = db ctx
let usrId = userId ctx
let now = jsNow ()
let now = now ctx
let (recur, interval) = parseRecurrence form
let req =
{ Request.empty with
userId = usrId
enteredOn = now
showAfter = Ticks 0L
showAfter = Instant.MinValue
recurType = recur
recurCount = interval
history = [
@ -506,13 +515,13 @@ module Request =
| false ->
do! Data.updateRecurrence req.requestId usrId recur interval db
match recur with
| Immediate -> do! Data.updateShowAfter req.requestId usrId (Ticks 0L) db
| Immediate -> do! Data.updateShowAfter req.requestId usrId Instant.MinValue db
| _ -> ()
// 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.ofString) form.status; text = text } db
{ asOf = now ctx; status = (Option.get >> RequestAction.ofString) form.status; text = text } db
do! db.saveChanges ()
let nextUrl =
match form.returnTo with

View File

@ -21,6 +21,7 @@
<PackageReference Include="Giraffe" Version="5.0.0" />
<PackageReference Include="LiteDB" Version="5.0.11" />
<PackageReference Include="Microsoft.AspNetCore.Authentication.OpenIdConnect" Version="5.0.10" />
<PackageReference Include="NodaTime" Version="3.0.9" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="../../../../Giraffe.Htmx/src/Htmx/Giraffe.Htmx.fsproj" />

View File

@ -61,6 +61,7 @@ module Configure =
open Microsoft.AspNetCore.Http
open Microsoft.Extensions.DependencyInjection
open Microsoft.IdentityModel.Protocols.OpenIdConnect
open NodaTime
open System
open System.Text.Json
open System.Text.Json.Serialization
@ -76,6 +77,7 @@ module Configure =
bldr.Services
.AddRouting()
.AddGiraffe()
.AddSingleton<IClock>(SystemClock.Instance)
.Configure<CookiePolicyOptions>(
fun (opts : CookiePolicyOptions) ->
opts.MinimumSameSitePolicy <- SameSiteMode.Unspecified

View File

@ -5,7 +5,7 @@ module private MyPrayerJournal.Views.Helpers
open Giraffe.ViewEngine
open Giraffe.ViewEngine.Htmx
open MyPrayerJournal
open System
open NodaTime
/// Create a link that targets the `#top` element and pushes a URL to history
let pageLink href attrs =
@ -26,10 +26,6 @@ let noResults heading link buttonText text =
]
]
/// 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.UtcNow date |> str ]
let relativeDate (date : Instant) now =
span [ _title (date.ToDateTimeOffset().ToString ("f", null)) ] [ Dates.formatDistance now date |> str ]

View File

@ -7,7 +7,7 @@ open Giraffe.ViewEngine.Htmx
open MyPrayerJournal
/// Display a card for this prayer request
let journalCard req =
let journalCard now req =
let reqId = RequestId.toString req.requestId
let spacer = span [] [ rawText "&nbsp;" ]
div [ _class "col" ] [
@ -48,7 +48,7 @@ let journalCard req =
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 ]
em [] [ str "last activity "; relativeDate req.asOf now ]
]
]
]
@ -113,7 +113,7 @@ let journal user = article [ _class "container-fluid mt-3" ] [
]
/// The journal items
let journalItems items =
let journalItems now items =
match items |> List.isEmpty with
| true ->
noResults "No Active Requests" "/request/new/edit" "Add a Request" [
@ -122,7 +122,7 @@ let journalItems items =
]
| false ->
items
|> List.map journalCard
|> List.map (journalCard now)
|> section [
_id "journalItems"
_class "row row-cols-1 row-cols-md-2 row-cols-lg-3 row-cols-xl-4 g-3"
@ -170,7 +170,7 @@ let snooze requestId =
_hxSwap HxSwap.OuterHtml
] [
div [ _class "form-floating pb-3" ] [
input [ _type "date"; _id "until"; _name "until"; _class "form-control"; _min today ]
input [ _type "date"; _id "until"; _name "until"; _class "form-control"; _min today; _required ]
label [ _for "until" ] [ str "Until" ]
]
p [ _class "text-end mb-0" ] [ button [ _type "submit"; _class "btn btn-primary" ] [ str "Snooze" ] ]

View File

@ -4,30 +4,26 @@ module MyPrayerJournal.Views.Request
open Giraffe.ViewEngine
open Giraffe.ViewEngine.Htmx
open MyPrayerJournal
open NodaTime
open System
/// Create a request within the list
let reqListItem req =
let jsNow = int64 (DateTime.UtcNow - DateTime.UnixEpoch).TotalMilliseconds
let reqListItem now req =
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 isSnoozed = req.snoozedUntil > now
let isPending = (not isSnoozed) && req.showAfter > now
let btnClass = _class "btn btn-light mx-2"
div [
_class "list-group-item px-0 d-flex flex-row align-items-start"
_hxTarget "this"
_hxSwap HxSwap.OuterHtml
] [
let restoreBtn (link : string) title =
button [ btnClass; _hxPatch $"/request/{reqId}/{link}"; _title title ] [ icon "restore" ]
div [ _class "list-group-item px-0 d-flex flex-row align-items-start"; _hxTarget "this"; _hxSwap HxSwap.OuterHtml ] [
pageLink $"/request/{reqId}/full" [ btnClass; _title "View Full Request" ] [ icon "description" ]
match isAnswered with
| true -> ()
| false -> button [ btnClass; _hxGet $"/components/request/{reqId}/edit"; _title "Edit Request" ] [ icon "edit" ]
| false -> pageLink $"/request/{reqId}/edit" [ btnClass; _title "Edit Request" ] [ icon "edit" ]
match true 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" ]
| _ when isSnoozed -> restoreBtn "cancel-snooze" "Cancel Snooze"
| _ when isPending -> restoreBtn "show" "Show Now"
| _ -> ()
p [ _class "request-text mb-0" ] [
str req.text
@ -36,9 +32,9 @@ let reqListItem req =
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 ]
| _ when isSnoozed -> [ str "Snooze expires "; relativeDate req.snoozedUntil now ]
| _ when isPending -> [ str "Request appears next "; relativeDate req.showAfter now ]
| _ (* isAnswered *) -> [ str "Answered "; relativeDate req.asOf now ]
|> em []
]
| false -> ()
@ -46,23 +42,23 @@ let reqListItem req =
]
/// Create a list of requests
let reqList reqs =
let reqList now reqs =
reqs
|> List.map reqListItem
|> List.map (reqListItem now)
|> div [ _class "list-group" ]
/// View for Active Requests page
let active reqs = article [ _class "container mt-3" ] [
let active now reqs = article [ _class "container mt-3" ] [
h2 [ _class "pb-3" ] [ 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
| false -> reqList now reqs
]
/// View for Answered Requests page
let answered reqs = article [ _class "container mt-3" ] [
let answered now reqs = article [ _class "container mt-3" ] [
h2 [ _class "pb-3" ] [ str "Answered Requests" ]
match reqs |> List.isEmpty with
| true ->
@ -70,38 +66,39 @@ let answered reqs = article [ _class "container mt-3" ] [
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
| false -> reqList now reqs
]
/// View for Snoozed Requests page
let snoozed reqs = article [ _class "container mt-3" ] [
let snoozed now reqs = article [ _class "container mt-3" ] [
h2 [ _class "pb-3" ] [ str "Snoozed Requests" ]
reqList reqs
reqList now reqs
]
/// View for Full Request page
let full (req : Request) =
let full (clock : IClock) (req : Request) =
let now = clock.GetCurrentInstant ()
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 prayed = (req.history |> List.filter RequestAction.isPrayed |> List.length).ToString "N0"
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 asOf = defaultArg answered now
((asOf - (req.history |> List.filter RequestAction.isCreated |> List.head).asOf).TotalDays |> int).ToString "N0"
let lastText =
req.history
|> List.filter (fun h -> Option.isSome h.text)
|> List.sortByDescending (fun h -> Ticks.toLong h.asOf)
|> List.sortByDescending (fun h -> 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 toDisp (h : History) = {| asOf = 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.map (fun n -> {| asOf = 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
@ -112,14 +109,14 @@ let full (req : Request) =
div [ _class "card-body" ] [
h6 [ _class "card-subtitle text-muted mb-2"] [
match answered with
| Some ticks ->
| Some date ->
str "Answered "
(fromJs ticks).ToString "D" |> str
date.ToDateTimeOffset().ToString ("D", null) |> str
str " ("
relativeDate ticks
relativeDate date now
rawText ") &bull; "
| None -> ()
sprintf "Prayed %i times &bull; Open %i days" prayed daysOpen |> rawText
sprintf "Prayed %s times &bull; Open %s days" prayed daysOpen |> rawText
]
p [ _class "card-text" ] [ str lastText ]
]
@ -128,7 +125,7 @@ let full (req : Request) =
p [ _class "m-0" ] [
str it.status
rawText "&nbsp; "
small [] [ em [] [ it.asOf.ToString "D" |> str ] ]
small [] [ em [] [ it.asOf.ToDateTimeOffset().ToString ("D", null) |> str ] ]
]
match it.text with
| Some txt -> p [ _class "mt-2 mb-0" ] [ str txt ]
@ -261,8 +258,9 @@ let edit (req : JournalRequest) returnTo isNew =
]
/// Display a list of notes for a request
let notes notes =
let toItem (note : Note) = p [] [ small [ _class "text-muted" ] [ relativeDate note.asOf ]; br []; str note.notes ]
let notes now notes =
let toItem (note : Note) =
p [] [ small [ _class "text-muted" ] [ relativeDate note.asOf now ]; br []; str note.notes ]
[ p [ _class "text-center" ] [ strong [] [ str "Prior Notes for This Request" ] ]
match notes with
| [] -> p [ _class "text-center text-muted" ] [ str "There are no prior notes for this request" ]

View File

@ -30,7 +30,7 @@ const mpj = {
body.innerText = msg
const toastEl = document.createElement("div")
toastEl.className = `toast bg-${level} text-white`
toastEl.className = `toast bg-${level === "error" ? "danger" : level} text-white`
toastEl.setAttribute("role", "alert")
toastEl.setAttribute("aria-live", "assertlive")
toastEl.setAttribute("aria-atomic", "true")