bit-badger/myPrayerJournal
1
0
Fork 0
Code Issues 1 Pull Requests Packages Projects Releases 36 Activity

Version 3 #67

Merged
danieljsummers merged 53 commits from version-3 into master 2021-10-26 23:39:59 +00:00
Conversation 0 Commits 53 Files Changed 70 +189 -149
11 changed files with 189 additions and 149 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files
Showing only changes of commit e235ea9bd3 - Show all commits

3
src/MyPrayerJournal/Server/.gitignore vendored
View File

@ -12,8 +12,5 @@ wwwroot/*.js.map
wwwroot/css wwwroot/css
wwwroot/js wwwroot/js
## Local library files
wwwroot/script/htmx*.js
## Development settings ## Development settings
appsettings.Development.json appsettings.Development.json

86
src/MyPrayerJournal/Server/Data.fs
View File

@ -14,10 +14,10 @@ module Extensions =
type LiteDatabase with type LiteDatabase with
/// The Request collection /// The Request collection
member this.requests member this.requests
with get () = this.GetCollection<Request>("request") with get () = this.GetCollection<Request> "request"
/// Async version of the checkpoint command (flushes log) /// Async version of the checkpoint command (flushes log)
member this.saveChanges () = member this.saveChanges () =
this.Checkpoint() this.Checkpoint ()
Task.CompletedTask Task.CompletedTask
@ -29,56 +29,56 @@ module Mapping =
/// Map a history entry to BSON /// Map a history entry to BSON
let historyToBson (hist : History) : BsonValue = let historyToBson (hist : History) : BsonValue =
let doc = BsonDocument () let doc = BsonDocument ()
doc.["asOf"] <- BsonValue (Ticks.toLong hist.asOf) doc["asOf"] <- Ticks.toLong hist.asOf
doc.["status"] <- BsonValue (RequestAction.toString hist.status) doc["status"] <- RequestAction.toString hist.status
doc.["text"] <- BsonValue (match hist.text with Some t -> t | None -> "") doc["text"] <- match hist.text with Some t -> t | None -> ""
upcast doc upcast doc
/// Map a BSON document to a history entry /// Map a BSON document to a history entry
let historyFromBson (doc : BsonValue) = let historyFromBson (doc : BsonValue) =
{ asOf = Ticks doc.["asOf"].AsInt64 { asOf = Ticks doc["asOf"].AsInt64
status = RequestAction.ofString doc.["status"].AsString status = RequestAction.ofString doc["status"].AsString
text = match doc.["text"].AsString with "" -> None | txt -> Some txt text = match doc["text"].AsString with "" -> None | txt -> Some txt
} }
/// Map a note entry to BSON /// Map a note entry to BSON
let noteToBson (note : Note) : BsonValue = let noteToBson (note : Note) : BsonValue =
let doc = BsonDocument () let doc = BsonDocument ()
doc.["asOf"] <- BsonValue (Ticks.toLong note.asOf) doc["asOf"] <- Ticks.toLong note.asOf
doc.["notes"] <- BsonValue note.notes doc["notes"] <- note.notes
upcast doc upcast doc
/// Map a BSON document to a note entry /// Map a BSON document to a note entry
let noteFromBson (doc : BsonValue) = let noteFromBson (doc : BsonValue) =
{ asOf = Ticks doc.["asOf"].AsInt64 { asOf = Ticks doc["asOf"].AsInt64
notes = doc.["notes"].AsString notes = doc["notes"].AsString
} }
/// Map a request to its BSON representation /// Map a request to its BSON representation
let requestToBson req : BsonValue = let requestToBson req : BsonValue =
let doc = BsonDocument () let doc = BsonDocument ()
doc.["_id"] <- BsonValue (RequestId.toString req.id) doc["_id"] <- RequestId.toString req.id
doc.["enteredOn"] <- BsonValue (Ticks.toLong req.enteredOn) doc["enteredOn"] <- Ticks.toLong req.enteredOn
doc.["userId"] <- BsonValue (UserId.toString req.userId) doc["userId"] <- UserId.toString req.userId
doc.["snoozedUntil"] <- BsonValue (Ticks.toLong req.snoozedUntil) doc["snoozedUntil"] <- Ticks.toLong req.snoozedUntil
doc.["showAfter"] <- BsonValue (Ticks.toLong req.showAfter) doc["showAfter"] <- Ticks.toLong req.showAfter
doc.["recurType"] <- BsonValue (Recurrence.toString req.recurType) doc["recurType"] <- Recurrence.toString req.recurType
doc.["recurCount"] <- BsonValue req.recurCount doc["recurCount"] <- BsonValue req.recurCount
doc.["history"] <- BsonArray (req.history |> List.map historyToBson |> Seq.ofList) doc["history"] <- BsonArray (req.history |> List.map historyToBson |> Seq.ofList)
doc.["notes"] <- BsonArray (req.notes |> List.map noteToBson |> Seq.ofList) doc["notes"] <- BsonArray (req.notes |> List.map noteToBson |> Seq.ofList)
upcast doc upcast doc
/// Map a BSON document to a request /// Map a BSON document to a request
let requestFromBson (doc : BsonValue) = let requestFromBson (doc : BsonValue) =
{ id = RequestId.ofString doc.["_id"].AsString { id = RequestId.ofString doc["_id"].AsString
enteredOn = Ticks doc.["enteredOn"].AsInt64 enteredOn = Ticks doc["enteredOn"].AsInt64
userId = UserId doc.["userId"].AsString userId = UserId doc["userId"].AsString
snoozedUntil = Ticks doc.["snoozedUntil"].AsInt64 snoozedUntil = Ticks doc["snoozedUntil"].AsInt64
showAfter = Ticks doc.["showAfter"].AsInt64 showAfter = Ticks doc["showAfter"].AsInt64
recurType = Recurrence.ofString doc.["recurType"].AsString recurType = Recurrence.ofString doc["recurType"].AsString
recurCount = int16 doc.["recurCount"].AsInt32 recurCount = int16 doc["recurCount"].AsInt32
history = doc.["history"].AsArray |> Seq.map historyFromBson |> List.ofSeq history = doc["history"].AsArray |> Seq.map historyFromBson |> List.ofSeq
notes = doc.["notes"].AsArray |> Seq.map noteFromBson |> List.ofSeq notes = doc["notes"].AsArray |> Seq.map noteFromBson |> List.ofSeq
} }
/// Set up the mapping /// Set up the mapping
@ -117,7 +117,7 @@ module private Helpers =
/// Retrieve a request, including its history and notes, by its ID and user ID /// Retrieve a request, including its history and notes, by its ID and user ID
let tryFullRequestById reqId userId (db : LiteDatabase) = task { let tryFullRequestById reqId userId (db : LiteDatabase) = task {
let! req = db.requests.Find (Query.EQ ("_id", RequestId.toString reqId |> BsonValue)) |> firstAsync let! req = db.requests.Find (Query.EQ ("_id", RequestId.toString reqId)) |> firstAsync
return match box req with null -> None | _ when req.userId = userId -> Some req | _ -> None return match box req with null -> None | _ when req.userId = userId -> Some req | _ -> None
} }
@ -125,14 +125,14 @@ let tryFullRequestById reqId userId (db : LiteDatabase) = task {
let addHistory reqId userId hist db = task { let addHistory reqId userId hist db = task {
match! tryFullRequestById reqId userId db with match! tryFullRequestById reqId userId db with
| Some req -> do! doUpdate db { req with history = hist :: req.history } | Some req -> do! doUpdate db { req with history = hist :: req.history }
| None -> invalidOp $"{RequestId.toString reqId} not found" | None -> invalidOp $"{RequestId.toString reqId} not found"
} }
/// Add a note /// Add a note
let addNote reqId userId note db = task { let addNote reqId userId note db = task {
match! tryFullRequestById reqId userId db with match! tryFullRequestById reqId userId db with
| Some req -> do! doUpdate db { req with notes = note :: req.notes } | Some req -> do! doUpdate db { req with notes = note :: req.notes }
| None -> invalidOp $"{RequestId.toString reqId} not found" | None -> invalidOp $"{RequestId.toString reqId} not found"
} }
/// Add a request /// Add a request
@ -141,7 +141,7 @@ let addRequest (req : Request) (db : LiteDatabase) =
/// Retrieve all answered requests for the given user /// Retrieve all answered requests for the given user
let answeredRequests userId (db : LiteDatabase) = task { let answeredRequests userId (db : LiteDatabase) = task {
let! reqs = db.requests.Find (Query.EQ ("userId", UserId.toString userId |> BsonValue)) |> toListAsync let! reqs = db.requests.Find (Query.EQ ("userId", UserId.toString userId)) |> toListAsync
return return
reqs reqs
|> Seq.map JournalRequest.ofRequestFull |> Seq.map JournalRequest.ofRequestFull
@ -152,7 +152,7 @@ let answeredRequests userId (db : LiteDatabase) = task {
/// Retrieve the user's current journal /// Retrieve the user's current journal
let journalByUserId userId (db : LiteDatabase) = task { let journalByUserId userId (db : LiteDatabase) = task {
let! jrnl = db.requests.Find (Query.EQ ("userId", UserId.toString userId |> BsonValue)) |> toListAsync let! jrnl = db.requests.Find (Query.EQ ("userId", UserId.toString userId)) |> toListAsync
return return
jrnl jrnl
|> Seq.map JournalRequest.ofRequestLite |> Seq.map JournalRequest.ofRequestLite
@ -163,9 +163,8 @@ let journalByUserId userId (db : LiteDatabase) = task {
/// Retrieve a request by its ID and user ID (without notes and history) /// Retrieve a request by its ID and user ID (without notes and history)
let tryRequestById reqId userId db = task { let tryRequestById reqId userId db = task {
match! tryFullRequestById reqId userId db with let! req = tryFullRequestById reqId userId db
| Some r -> return Some { r with history = []; notes = [] } return req |> Option.map (fun r -> { r with history = []; notes = [] })
| _ -> return None
} }
/// Retrieve notes for a request by its ID and user ID /// Retrieve notes for a request by its ID and user ID
@ -175,28 +174,27 @@ let notesById reqId userId (db : LiteDatabase) = task {
/// Retrieve a journal request by its ID and user ID /// Retrieve a journal request by its ID and user ID
let tryJournalById reqId userId (db : LiteDatabase) = task { let tryJournalById reqId userId (db : LiteDatabase) = task {
match! tryFullRequestById reqId userId db with let! req = tryFullRequestById reqId userId db
| Some req -> return req |> (JournalRequest.ofRequestLite >> Some) return req |> Option.map JournalRequest.ofRequestLite
| None -> return None
} }
/// Update the recurrence for a request /// Update the recurrence for a request
let updateRecurrence reqId userId recurType recurCount db = task { let updateRecurrence reqId userId recurType recurCount db = task {
match! tryFullRequestById reqId userId db with match! tryFullRequestById reqId userId db with
| Some req -> do! doUpdate db { req with recurType = recurType; recurCount = recurCount } | Some req -> do! doUpdate db { req with recurType = recurType; recurCount = recurCount }
| None -> invalidOp $"{RequestId.toString reqId} not found" | None -> invalidOp $"{RequestId.toString reqId} not found"
} }
/// Update a snoozed request /// Update a snoozed request
let updateSnoozed reqId userId until db = task { let updateSnoozed reqId userId until db = task {
match! tryFullRequestById reqId userId db with match! tryFullRequestById reqId userId db with
| Some req -> do! doUpdate db { req with snoozedUntil = until; showAfter = until } | Some req -> do! doUpdate db { req with snoozedUntil = until; showAfter = until }
| None -> invalidOp $"{RequestId.toString reqId} not found" | None -> invalidOp $"{RequestId.toString reqId} not found"
} }
/// Update the "show after" timestamp for a request /// Update the "show after" timestamp for a request
let updateShowAfter reqId userId showAfter db = task { let updateShowAfter reqId userId showAfter db = task {
match! tryFullRequestById reqId userId db with match! tryFullRequestById reqId userId db with
| Some req -> do! doUpdate db { req with showAfter = showAfter } | Some req -> do! doUpdate db { req with showAfter = showAfter }
| None -> invalidOp $"{RequestId.toString reqId} not found" | None -> invalidOp $"{RequestId.toString reqId} not found"
} }

62
src/MyPrayerJournal/Server/Dates.fs
View File

@ -4,19 +4,19 @@ module MyPrayerJournal.Dates
type internal FormatDistanceToken = type internal FormatDistanceToken =
| LessThanXMinutes | LessThanXMinutes
| XMinutes | XMinutes
| AboutXHours | AboutXHours
| XHours | XHours
| XDays | XDays
| AboutXWeeks | AboutXWeeks
| XWeeks | XWeeks
| AboutXMonths | AboutXMonths
| XMonths | XMonths
| AboutXYears | AboutXYears
| XYears | XYears
| OverXYears | OverXYears
| AlmostXYears | AlmostXYears
let internal locales = let internal locales =
let format = PrintfFormat<int -> string, unit, string, string> let format = PrintfFormat<int -> string, unit, string, string>
@ -38,10 +38,10 @@ let internal locales =
] ]
] ]
let aDay = 1_440. let aDay = 1_440.
let almostTwoDays = 2_520. let almost2Days = 2_520.
let aMonth = 43_200. let aMonth = 43_200.
let twoMonths = 86_400. let twoMonths = 86_400.
open System open System
@ -51,7 +51,7 @@ let fromJs ticks = DateTime.UnixEpoch + TimeSpan.FromTicks (ticks * 10_000L)
let formatDistance (startDate : DateTime) (endDate : DateTime) = let formatDistance (startDate : DateTime) (endDate : DateTime) =
let format (token, number) locale = let format (token, number) locale =
let labels = locales |> Map.find locale let labels = locales |> Map.find locale
match number with 1 -> fst labels.[token] | _ -> sprintf (snd labels.[token]) number match number with 1 -> fst labels[token] | _ -> sprintf (snd labels[token]) number
let round (it : float) = Math.Round it |> int let round (it : float) = Math.Round it |> int
let diff = startDate - endDate let diff = startDate - endDate
@ -60,18 +60,18 @@ let formatDistance (startDate : DateTime) (endDate : DateTime) =
let months = minutes / aMonth |> round let months = minutes / aMonth |> round
let years = months / 12 let years = months / 12
match true with match true with
| _ when minutes < 1. -> LessThanXMinutes, 1 | _ when minutes < 1. -> LessThanXMinutes, 1
| _ when minutes < 45. -> XMinutes, round minutes | _ when minutes < 45. -> XMinutes, round minutes
| _ when minutes < 90. -> AboutXHours, 1 | _ when minutes < 90. -> AboutXHours, 1
| _ when minutes < aDay -> AboutXHours, round (minutes / 60.) | _ when minutes < aDay -> AboutXHours, round (minutes / 60.)
| _ when minutes < almostTwoDays -> XDays, 1 | _ when minutes < almost2Days -> XDays, 1
| _ when minutes < aMonth -> XDays, round (minutes / aDay) | _ when minutes < aMonth -> XDays, round (minutes / aDay)
| _ when minutes < twoMonths -> AboutXMonths, round (minutes / aMonth) | _ when minutes < twoMonths -> AboutXMonths, round (minutes / aMonth)
| _ when months < 12 -> XMonths, round (minutes / aMonth) | _ when months < 12 -> XMonths, round (minutes / aMonth)
| _ when months % 12 < 3 -> AboutXYears, years | _ when months % 12 < 3 -> AboutXYears, years
| _ when months % 12 < 9 -> OverXYears, years | _ when months % 12 < 9 -> OverXYears, years
| _ -> AlmostXYears, years + 1 | _ -> AlmostXYears, years + 1
let words = format formatToken "en-US" format formatToken "en-US"
match startDate > endDate with true -> $"{words} ago" | false -> $"in {words}" |> match startDate > endDate with true -> sprintf "%s ago" | false -> sprintf "in %s"

2
src/MyPrayerJournal/Server/Domain.fs
View File

@ -180,7 +180,7 @@ module JournalRequest =
|> List.tryHead |> List.tryHead
|> Option.map (fun h -> Option.get h.text) |> Option.map (fun h -> Option.get h.text)
|> Option.defaultValue "" |> Option.defaultValue ""
asOf = match hist with Some h -> h.asOf | None -> Ticks 0L asOf = match hist with Some h -> h.asOf | None -> Ticks 0L
lastStatus = match hist with Some h -> h.status | None -> Created lastStatus = match hist with Some h -> h.status | None -> Created
snoozedUntil = req.snoozedUntil snoozedUntil = req.snoozedUntil
showAfter = req.showAfter showAfter = req.showAfter

61
src/MyPrayerJournal/Server/Handlers.fs
View File

@ -93,7 +93,7 @@ module private Helpers =
/// Return a 303 SEE OTHER response (forces a GET on the redirected URL) /// Return a 303 SEE OTHER response (forces a GET on the redirected URL)
let seeOther (url : string) = let seeOther (url : string) =
setStatusCode 303 >=> setHttpHeader "Location" url noResponseCaching >=> setStatusCode 303 >=> setHttpHeader "Location" url
/// The "now" time in JavaScript as Ticks /// The "now" time in JavaScript as Ticks
let jsNow () = let jsNow () =
@ -101,7 +101,8 @@ module private Helpers =
/// Render a component result /// Render a component result
let renderComponent nodes : HttpHandler = let renderComponent nodes : HttpHandler =
fun next ctx -> task { noResponseCaching
>=> fun next ctx -> task {
return! ctx.WriteHtmlStringAsync (ViewEngine.RenderView.AsString.htmlNodes nodes) return! ctx.WriteHtmlStringAsync (ViewEngine.RenderView.AsString.htmlNodes nodes)
} }
@ -143,8 +144,8 @@ module private Helpers =
msg |> Option.iter (fun _ -> messages <- messages.Remove userId) msg |> Option.iter (fun _ -> messages <- messages.Remove userId)
msg) msg)
/// Send a partial result if this is not a full page load /// Send a partial result if this is not a full page load (does not append no-cache headers)
let partialIfNotRefresh (pageTitle : string) content : HttpHandler = let partialStatic (pageTitle : string) content : HttpHandler =
fun next ctx -> fun next ctx ->
let isPartial = ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh let isPartial = ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh
let view = let view =
@ -158,6 +159,9 @@ module private Helpers =
| None -> writeView view | None -> writeView view
| None -> writeView view | None -> writeView view
/// Send an explicitly non-cached result, rendering as a partial if this is not a full page load
let partial pageTitle content =
noResponseCaching >=> partialStatic pageTitle content
/// Add a success message header to the response /// Add a success message header to the response
let withSuccessMessage : string -> HttpHandler = let withSuccessMessage : string -> HttpHandler =
@ -222,9 +226,14 @@ module Components =
>=> fun next ctx -> task { >=> fun next ctx -> task {
match! Data.tryJournalById (RequestId.ofString reqId) (userId ctx) (db ctx) with 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 req ] next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
/// GET /components/request/[req-id]/add-notes
let addNotes requestId : HttpHandler =
requiresAuthentication Error.notAuthorized
>=> renderComponent (Views.Journal.notesEdit (RequestId.ofString requestId))
/// GET /components/request/[req-id]/notes /// GET /components/request/[req-id]/notes
let notes requestId : HttpHandler = let notes requestId : HttpHandler =
requiresAuthentication Error.notAuthorized requiresAuthentication Error.notAuthorized
@ -239,7 +248,7 @@ module Home =
// GET / // GET /
let home : HttpHandler = let home : HttpHandler =
partialIfNotRefresh "Welcome!" Views.Home.home partialStatic "Welcome!" Views.Home.home
/// /journal URL /// /journal URL
@ -255,7 +264,7 @@ module Journal =
|> Option.map (fun c -> c.Value) |> Option.map (fun c -> c.Value)
|> Option.defaultValue "Your" |> Option.defaultValue "Your"
let title = usr |> match usr with "Your" -> sprintf "%s" | _ -> sprintf "%s's" let title = usr |> match usr with "Your" -> sprintf "%s" | _ -> sprintf "%s's"
return! partialIfNotRefresh (sprintf "%s Prayer Journal" title) (Views.Journal.journal usr) next ctx return! partial (sprintf "%s Prayer Journal" title) (Views.Journal.journal usr) next ctx
} }
@ -264,15 +273,11 @@ module Legal =
// GET /legal/privacy-policy // GET /legal/privacy-policy
let privacyPolicy : HttpHandler = let privacyPolicy : HttpHandler =
partialIfNotRefresh "Privacy Policy" Views.Legal.privacyPolicy partialStatic "Privacy Policy" Views.Legal.privacyPolicy
// GET /legal/terms-of-service // GET /legal/terms-of-service
let termsOfService : HttpHandler = let termsOfService : HttpHandler =
partialIfNotRefresh "Terms of Service" Views.Legal.termsOfService partialStatic "Terms of Service" Views.Legal.termsOfService
/// Alias for the Ply task module (The F# "task" CE can't handle differing types well within the same CE)
module Ply = FSharp.Control.Tasks.Affine
/// /api/request and /request(s) URLs /// /api/request and /request(s) URLs
@ -289,13 +294,12 @@ module Request =
| _ -> "journal" | _ -> "journal"
match requestId with match requestId with
| "new" -> | "new" ->
return! partialIfNotRefresh "Add Prayer Request" return! partial "Add Prayer Request"
(Views.Request.edit (JournalRequest.ofRequestLite Request.empty) returnTo true) next ctx (Views.Request.edit (JournalRequest.ofRequestLite Request.empty) returnTo true) next ctx
| _ -> | _ ->
match! Data.tryJournalById (RequestId.ofString requestId) (userId ctx) (db ctx) with match! Data.tryJournalById (RequestId.ofString requestId) (userId ctx) (db ctx) with
| Some req -> | Some req -> return! partial "Edit Prayer Request" (Views.Request.edit req returnTo false) next ctx
return! partialIfNotRefresh "Edit Prayer Request" (Views.Request.edit req returnTo false) next ctx | None -> return! Error.notFound next ctx
| None -> return! Error.notFound next ctx
} }
// PATCH /request/[req-id]/prayed // PATCH /request/[req-id]/prayed
@ -311,7 +315,7 @@ module Request =
do! Data.addHistory reqId usrId { asOf = now; status = Prayed; text = None } db do! Data.addHistory reqId usrId { asOf = now; status = Prayed; text = None } db
let nextShow = let nextShow =
match Recurrence.duration req.recurType with match Recurrence.duration req.recurType with
| 0L -> 0L | 0L -> 0L
| duration -> (Ticks.toLong now) + (duration * int64 req.recurCount) | duration -> (Ticks.toLong now) + (duration * int64 req.recurCount)
do! Data.updateShowAfter reqId usrId (Ticks nextShow) db do! Data.updateShowAfter reqId usrId (Ticks nextShow) db
do! db.saveChanges () do! db.saveChanges ()
@ -340,7 +344,7 @@ module Request =
requiresAuthentication Error.notAuthorized requiresAuthentication Error.notAuthorized
>=> fun next ctx -> task { >=> fun next ctx -> task {
let! reqs = Data.journalByUserId (userId ctx) (db ctx) let! reqs = Data.journalByUserId (userId ctx) (db ctx)
return! partialIfNotRefresh "Active Requests" (Views.Request.active reqs) next ctx return! partial "Active Requests" (Views.Request.active reqs) next ctx
} }
// GET /requests/snoozed // GET /requests/snoozed
@ -350,7 +354,7 @@ module Request =
let! reqs = Data.journalByUserId (userId ctx) (db ctx) let! reqs = Data.journalByUserId (userId ctx) (db ctx)
let now = (jsNow >> Ticks.toLong) () let now = (jsNow >> Ticks.toLong) ()
let snoozed = reqs |> List.filter (fun r -> Ticks.toLong r.snoozedUntil > now) let snoozed = reqs |> List.filter (fun r -> Ticks.toLong r.snoozedUntil > now)
return! partialIfNotRefresh "Active Requests" (Views.Request.snoozed snoozed) next ctx return! partial "Active Requests" (Views.Request.snoozed snoozed) next ctx
} }
// GET /requests/answered // GET /requests/answered
@ -358,7 +362,7 @@ module Request =
requiresAuthentication Error.notAuthorized requiresAuthentication Error.notAuthorized
>=> fun next ctx -> task { >=> fun next ctx -> task {
let! reqs = Data.answeredRequests (userId ctx) (db ctx) let! reqs = Data.answeredRequests (userId ctx) (db ctx)
return! partialIfNotRefresh "Answered Requests" (Views.Request.answered reqs) next ctx return! partial "Answered Requests" (Views.Request.answered reqs) next ctx
} }
/// GET /api/request/[req-id] /// GET /api/request/[req-id]
@ -375,8 +379,8 @@ module Request =
requiresAuthentication Error.notAuthorized requiresAuthentication Error.notAuthorized
>=> fun next ctx -> task { >=> fun next ctx -> task {
match! Data.tryFullRequestById (RequestId.ofString requestId) (userId ctx) (db ctx) with match! Data.tryFullRequestById (RequestId.ofString requestId) (userId ctx) (db ctx) with
| Some req -> return! partialIfNotRefresh "Prayer Request" (Views.Request.full req) next ctx | Some req -> return! partial "Prayer Request" (Views.Request.full req) next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }
// PATCH /request/[req-id]/show // PATCH /request/[req-id]/show
@ -462,7 +466,7 @@ module Request =
// PATCH /request // PATCH /request
let update : HttpHandler = let update : HttpHandler =
requiresAuthentication Error.notAuthorized requiresAuthentication Error.notAuthorized
>=> fun next ctx -> Ply.task { >=> fun next ctx -> task {
let! form = ctx.BindModelAsync<Models.Request> () let! form = ctx.BindModelAsync<Models.Request> ()
let db = db ctx let db = db ctx
let usrId = userId ctx let usrId = userId ctx
@ -520,9 +524,10 @@ let routes =
[ GET_HEAD [ route "/" Home.home ] [ GET_HEAD [ route "/" Home.home ]
subRoute "/components/" [ subRoute "/components/" [
GET_HEAD [ GET_HEAD [
route "journal-items" Components.journalItems route "journal-items" Components.journalItems
routef "request/%s/item" Components.requestItem routef "request/%s/add-notes" Components.addNotes
routef "request/%s/notes" Components.notes routef "request/%s/item" Components.requestItem
routef "request/%s/notes" Components.notes
] ]
] ]
GET_HEAD [ route "/journal" Journal.journal ] GET_HEAD [ route "/journal" Journal.journal ]

13
src/MyPrayerJournal/Server/Program.fs
View File

@ -92,9 +92,9 @@ module Configure =
/// Configure OIDC with Auth0 options from configuration /// Configure OIDC with Auth0 options from configuration
fun opts -> fun opts ->
let cfg = bldr.Configuration.GetSection "Auth0" let cfg = bldr.Configuration.GetSection "Auth0"
opts.Authority <- sprintf "https://%s/" cfg.["Domain"] opts.Authority <- sprintf "https://%s/" cfg["Domain"]
opts.ClientId <- cfg.["Id"] opts.ClientId <- cfg["Id"]
opts.ClientSecret <- cfg.["Secret"] opts.ClientSecret <- cfg["Secret"]
opts.ResponseType <- OpenIdConnectResponseType.Code opts.ResponseType <- OpenIdConnectResponseType.Code
opts.Scope.Clear () opts.Scope.Clear ()
@ -119,7 +119,7 @@ module Configure =
sprintf "%s://%s%s%s" request.Scheme request.Host.Value request.PathBase.Value redirUri sprintf "%s://%s%s%s" request.Scheme request.Host.Value request.PathBase.Value redirUri
| false -> redirUri | false -> redirUri
Uri.EscapeDataString finalRedirUri |> sprintf "&returnTo=%s" Uri.EscapeDataString finalRedirUri |> sprintf "&returnTo=%s"
sprintf "https://%s/v2/logout?client_id=%s%s" cfg.["Domain"] cfg.["Id"] returnTo sprintf "https://%s/v2/logout?client_id=%s%s" cfg["Domain"] cfg["Id"] returnTo
|> ctx.Response.Redirect |> ctx.Response.Redirect
ctx.HandleResponse () ctx.HandleResponse ()
@ -132,7 +132,7 @@ module Configure =
Data.Startup.ensureDb db Data.Startup.ensureDb db
bldr.Services.AddSingleton(jsonOptions) bldr.Services.AddSingleton(jsonOptions)
.AddSingleton<Json.ISerializer, SystemTextJson.Serializer>() .AddSingleton<Json.ISerializer, SystemTextJson.Serializer>()
.AddSingleton<LiteDatabase>(db) .AddSingleton<LiteDatabase> db
|> ignore |> ignore
bldr.Build () bldr.Build ()
@ -155,7 +155,8 @@ module Configure =
.UseEndpoints (fun e -> .UseEndpoints (fun e ->
e.MapGiraffeEndpoints Handlers.routes e.MapGiraffeEndpoints Handlers.routes
// TODO: fallback to 404 // TODO: fallback to 404
e.MapFallbackToFile "index.html" |> ignore) // e.MapFallbackToFile "index.html"
|> ignore)
|> ignore |> ignore
app app

78
src/MyPrayerJournal/Server/Views.fs
View File

@ -54,7 +54,7 @@ module private Helpers =
span [ _title (date.ToString "f") ] [ Dates.formatDistance DateTime.UtcNow date |> str ] span [ _title (date.ToString "f") ] [ Dates.formatDistance DateTime.UtcNow date |> str ]
/// Views for home and log on pages /// View for home page
module Home = module Home =
/// The home page /// The home page
@ -72,13 +72,6 @@ module Home =
] ]
] ]
/// The log on page
let logOn = article [ _class "container mt-3" ] [
p [] [
em [] [ str "Verifying..." ]
]
]
/// Views for legal pages /// Views for legal pages
module Legal = module Legal =
@ -277,12 +270,14 @@ module Journal =
pageLink $"/request/{reqId}/edit" [ _class "btn btn-secondary"; _title "Edit Request" ] [ icon "edit" ] pageLink $"/request/{reqId}/edit" [ _class "btn btn-secondary"; _title "Edit Request" ] [ icon "edit" ]
spacer spacer
button [ button [
_type "button" _type "button"
_class "btn btn-secondary" _class "btn btn-secondary"
_title "Add Notes" _title "Add Notes"
_data "bs-toggle" "modal" _data "bs-toggle" "modal"
_data "bs-target" "#notesModal" _data "bs-target" "#notesModal"
_data "request-id" reqId _hxGet $"/components/request/{reqId}/add-notes"
_hxTarget "#notesBody"
_hxSwap HxSwap.InnerHtml
] [ icon "comment" ] ] [ icon "comment" ]
spacer spacer
// md-button(@click.stop='snooze()').md-icon-button.md-raised // md-button(@click.stop='snooze()').md-icon-button.md-raised
@ -336,27 +331,13 @@ module Journal =
h5 [ _class "modal-title"; _id "nodesModalLabel" ] [ str "Add Notes to Prayer Request" ] h5 [ _class "modal-title"; _id "nodesModalLabel" ] [ str "Add Notes to Prayer Request" ]
button [ _type "button"; _class "btn-close"; _data "bs-dismiss" "modal"; _ariaLabel "Close" ] [] button [ _type "button"; _class "btn-close"; _data "bs-dismiss" "modal"; _ariaLabel "Close" ] []
] ]
div [ _class "modal-body" ] [ div [ _class "modal-body"; _id "notesBody" ] [ ]
form [ _id "notesForm"; _method "POST"; _action ""; _hxBoost; _hxTarget "#top" ] [
str "TODO"
button [ _type "submit"; _class "btn btn-primary" ] [ str "Add Notes" ]
]
hr []
div [
_id "notesLoad"
_class "btn btn-secondary"
_hxGet ""
_hxSwap HxSwap.OuterHtml
_hxTarget "this"
] [ str "Load Prior Notes" ]
]
div [ _class "modal-footer" ] [ div [ _class "modal-footer" ] [
button [ _type "button"; _class "btn btn-secondary"; _data "bs-dismiss" "modal" ] [ str "Close" ] button [ _type "button"; _class "btn btn-secondary"; _data "bs-dismiss" "modal" ] [ str "Close" ]
] ]
] ]
] ]
] ]
script [] [ str "setTimeout(function () { mpj.journal.setUp() }, 1000)" ]
] ]
/// The journal items /// The journal items
@ -376,6 +357,25 @@ module Journal =
_hxSwap HxSwap.OuterHtml _hxSwap HxSwap.OuterHtml
] ]
/// The notes edit modal body
let notesEdit requestId =
let reqId = RequestId.toString requestId
[ form [ _hxPost $"/request/{reqId}/note"; _hxTarget "#top" ] [
str "TODO"
button [ _type "submit"; _class "btn btn-primary" ] [ str "Add Notes" ]
]
div [ _id "priorNotes" ] [
p [ _class "text-center pt-5" ] [
button [
_type "button"
_class "btn btn-secondary"
_hxGet $"/components/request/{reqId}/notes"
_hxSwap HxSwap.OuterHtml
_hxTarget "#priorNotes"
] [str "Load Prior Notes" ]
]
]
]
/// Views for request pages and components /// Views for request pages and components
@ -396,10 +396,9 @@ module Request =
] [ ] [
pageLink $"/request/{reqId}/full" [ btnClass; _title "View Full Request" ] [ icon "description" ] pageLink $"/request/{reqId}/full" [ btnClass; _title "View Full Request" ] [ icon "description" ]
match isAnswered with match isAnswered with
| true -> () | true -> ()
| false -> | false -> button [ btnClass; _hxGet $"/components/request/{reqId}/edit"; _title "Edit Request" ] [ icon "edit" ]
button [ btnClass; _hxGet $"/components/request/{reqId}/edit"; _title "Edit Request" ] [ icon "edit" ] match true with
match () with
| _ when isSnoozed -> | _ when isSnoozed ->
button [ btnClass; _hxPatch $"/request/{reqId}/cancel-snooze"; _title "Cancel Snooze" ] [ icon "restore" ] button [ btnClass; _hxPatch $"/request/{reqId}/cancel-snooze"; _title "Cancel Snooze" ] [ icon "restore" ]
| _ when isPending -> | _ when isPending ->
@ -522,7 +521,7 @@ module Request =
| "snoozed" -> "/requests/snoozed" | "snoozed" -> "/requests/snoozed"
| _ (* "journal" *) -> "/journal" | _ (* "journal" *) -> "/journal"
article [ _class "container" ] [ article [ _class "container" ] [
h5 [ _class "pb-3" ] [ (match isNew with true -> "Add" | false -> "Edit") |> strf "%s Prayer Request" ] h2 [ _class "pb-3" ] [ (match isNew with true -> "Add" | false -> "Edit") |> strf "%s Prayer Request" ]
form [ form [
_hxBoost _hxBoost
_hxTarget "#top" _hxTarget "#top"
@ -639,7 +638,8 @@ module Request =
/// Display a list of notes for a request /// Display a list of notes for a request
let notes notes = let notes notes =
let toItem (note : Note) = p [] [ small [ _class "text-muted" ] [ relativeDate note.asOf ]; br []; str note.notes ] let toItem (note : Note) = p [] [ small [ _class "text-muted" ] [ relativeDate note.asOf ]; br []; str note.notes ]
[ p [ _class "text-center" ] [ strong [] [ str "Prior Notes for This Request" ] ] [ hr [ _style "margin: .5rem -1rem" ]
p [ _class "text-center" ] [ strong [] [ str "Prior Notes for This Request" ] ]
match notes with match notes with
| [] -> p [ _class "text-center text-muted" ] [ str "There are no prior notes for this request" ] | [] -> p [ _class "text-center text-muted" ] [ str "There are no prior notes for this request" ]
| _ -> yield! notes |> List.map toItem | _ -> yield! notes |> List.map toItem
@ -696,12 +696,20 @@ module Layout =
_integrity "sha384-oGA+prIp5Vchu6we2YkI51UtVzN9Jpx2Z7PnR1I78PnZlN8LkrCT4lqqqmDkyrvI" _integrity "sha384-oGA+prIp5Vchu6we2YkI51UtVzN9Jpx2Z7PnR1I78PnZlN8LkrCT4lqqqmDkyrvI"
_crossorigin "anonymous" _crossorigin "anonymous"
] [] ] []
script [] [
rawText "if (!htmx) document.write('<script src=\"/script/htmx-1.5.0.min.js\"><\/script>')"
]
script [ script [
_async _async
_src "https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/js/bootstrap.bundle.min.js" _src "https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/js/bootstrap.bundle.min.js"
_integrity "sha384-MrcW6ZMFYlzcLA8Nl+NtUVF0sA7MsXsP1UyJoMp4YLEuNSfAP+JcXn/tWtIaxVXM" _integrity "sha384-MrcW6ZMFYlzcLA8Nl+NtUVF0sA7MsXsP1UyJoMp4YLEuNSfAP+JcXn/tWtIaxVXM"
_crossorigin "anonymous" _crossorigin "anonymous"
] [] ] []
script [] [
rawText "setTimeout(function () { "
rawText "if (!bootstrap) document.write('<script src=\"/script/bootstrap.bundle.min.js\"><\/script>') "
rawText "}, 2000)"
]
script [ _src "/script/mpj.js" ] [] script [ _src "/script/mpj.js" ] []
] ]

7
src/MyPrayerJournal/Server/wwwroot/script/bootstrap.bundle.min.js vendored Normal file
View File

File diff suppressed because one or more lines are too long

1
src/MyPrayerJournal/Server/wwwroot/script/htmx-1.5.0.min.js vendored Normal file
View File

File diff suppressed because one or more lines are too long

16
src/MyPrayerJournal/Server/wwwroot/script/mpj.js
View File

@ -41,6 +41,21 @@ const mpj = {
document.getElementById("toasts").appendChild(toastEl) document.getElementById("toasts").appendChild(toastEl)
new bootstrap.Toast(toastEl, { autohide: level === "success" }).show() new bootstrap.Toast(toastEl, { autohide: level === "success" }).show()
}, },
/**
* Load local version of Bootstrap CSS if the CDN load failed
*/
ensureCss () {
let loaded = false
for (let i = 0; !loaded && i < document.styleSheets.length; i++) {
loaded = document.styleSheets[i].href.endsWith("bootstrap.min.css")
}
if (!loaded) {
const css = document.createElement("link")
css.rel = "stylesheet"
css.href = "/style/bootstrap.min.css"
document.getElementsByTagName("head")[0].appendChild(css)
}
},
/** Script for the request edit component */ /** Script for the request edit component */
edit: { edit: {
/** /**
@ -74,3 +89,4 @@ htmx.on("htmx:afterOnLoad", function (evt) {
mpj.showToast(evt.detail.xhr.getResponseHeader("x-toast")) mpj.showToast(evt.detail.xhr.getResponseHeader("x-toast"))
} }
}) })

7
src/MyPrayerJournal/Server/wwwroot/style/bootstrap.min.css vendored Normal file
View File

File diff suppressed because one or more lines are too long