From 0d86bad7c5c55d4c00be53c76cd9f43afa2d891f Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Fri, 29 Jul 2022 20:20:18 -0400 Subject: [PATCH] Reformat source files --- .../Program.fs | 115 ++- src/MyPrayerJournal/Data.fs | 228 ++--- src/MyPrayerJournal/Dates.fs | 106 +- src/MyPrayerJournal/Domain.fs | 357 ++++--- src/MyPrayerJournal/Handlers.fs | 916 +++++++++--------- src/MyPrayerJournal/Views/Helpers.fs | 20 +- src/MyPrayerJournal/Views/Journal.fs | 289 +++--- src/MyPrayerJournal/Views/Layout.fs | 219 ++--- src/MyPrayerJournal/Views/Legal.fs | 291 +++--- src/MyPrayerJournal/Views/Request.fs | 468 +++++---- 10 files changed, 1519 insertions(+), 1490 deletions(-) diff --git a/src/MyPrayerJournal.ConvertRecurrence/Program.fs b/src/MyPrayerJournal.ConvertRecurrence/Program.fs index 1247406..1fae3cd 100644 --- a/src/MyPrayerJournal.ConvertRecurrence/Program.fs +++ b/src/MyPrayerJournal.ConvertRecurrence/Program.fs @@ -3,26 +3,56 @@ open NodaTime /// Request is the identifying record for a prayer request [] -type OldRequest = { - /// The ID of the request - id : RequestId - /// The time this request was initially entered - 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 : Instant - /// The time at which this request should reappear in the user's journal by recurrence - showAfter : Instant - /// The type of recurrence for this request - recurType : string - /// How many of the recurrence intervals should occur between appearances in the journal - recurCount : int16 - /// The history entries for this request - history : History array - /// The notes for this request - notes : Note array - } +type OldRequest = + { /// The ID of the request + id : RequestId + + /// The time this request was initially entered + 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 : Instant + + /// The time at which this request should reappear in the user's journal by recurrence + showAfter : Instant + + /// The type of recurrence for this request + recurType : string + + /// How many of the recurrence intervals should occur between appearances in the journal + recurCount : int16 + + /// The history entries for this request + history : History array + + /// The notes for this request + notes : Note array + } + +/// The old definition of the history entry +[] +type OldHistory = + { /// The time when this history entry was made + asOf : Instant + /// The status for this history entry + status : RequestAction + /// The text of the update, if applicable + text : string option + } + +/// The old definition of of the note entry +[] +type OldNote = + { /// The time when this note was made + asOf : Instant + + /// The text of the notes + notes : string + } + open LiteDB open MyPrayerJournal.Data @@ -32,36 +62,33 @@ Startup.ensureDb db /// Map the old recurrence to the new style let mapRecurrence old = - match old.recurType with - | "Days" -> Days old.recurCount - | "Hours" -> Hours old.recurCount - | "Weeks" -> Weeks old.recurCount - | _ -> Immediate + match old.recurType with + | "Days" -> Days old.recurCount + | "Hours" -> Hours old.recurCount + | "Weeks" -> Weeks old.recurCount + | _ -> Immediate /// Map the old request to the new request -let convert old = { - id = old.id - enteredOn = old.enteredOn - userId = old.userId - snoozedUntil = old.snoozedUntil - showAfter = old.showAfter - recurrence = mapRecurrence old - history = Array.toList old.history - notes = Array.toList old.notes - } +let convert old = + { id = old.id + enteredOn = old.enteredOn + userId = old.userId + snoozedUntil = old.snoozedUntil + showAfter = old.showAfter + recurrence = mapRecurrence old + history = Array.toList old.history + notes = Array.toList old.notes + } /// Remove the old request, add the converted one (removes recurType / recurCount fields) let replace (req : Request) = - db.requests.Delete(Mapping.RequestId.toBson req.id) |> ignore - db.requests.Insert(req) |> ignore - db.Checkpoint() + db.requests.Delete(Mapping.RequestId.toBson req.id) |> ignore + db.requests.Insert(req) |> ignore + db.Checkpoint() -let reqs = db.GetCollection("request").FindAll() -let rList = reqs |> Seq.toList -let mapped = rList |> List.map convert -//let reqList = mapped |> List.ofSeq - -mapped |> List.iter replace +db.GetCollection("request").FindAll() +|> Seq.map convert +|> Seq.iter replace // For more information see https://aka.ms/fsharp-console-apps printfn "Done" diff --git a/src/MyPrayerJournal/Data.fs b/src/MyPrayerJournal/Data.fs index e880dad..bf9f082 100644 --- a/src/MyPrayerJournal/Data.fs +++ b/src/MyPrayerJournal/Data.fs @@ -11,15 +11,17 @@ open System.Threading.Tasks [] module Extensions = - /// Extensions on the LiteDatabase class - type LiteDatabase with - /// The Request collection - member this.requests - with get () = this.GetCollection "request" - /// Async version of the checkpoint command (flushes log) - member this.saveChanges () = - this.Checkpoint () - Task.CompletedTask + /// Extensions on the LiteDatabase class + type LiteDatabase with + + /// The Request collection + member this.requests + with get () = this.GetCollection "request" + + /// Async version of the checkpoint command (flushes log) + member this.saveChanges () = + this.Checkpoint () + Task.CompletedTask /// Map domain to LiteDB @@ -27,162 +29,162 @@ module Extensions = [] module Mapping = - /// Mapping for NodaTime's Instant type - module Instant = - let fromBson (value : BsonValue) = Instant.FromUnixTimeMilliseconds value.AsInt64 - let toBson (value : Instant) : BsonValue = value.ToUnixTimeMilliseconds () - - /// Mapping for option types - module Option = - let stringFromBson (value : BsonValue) = match value.AsString with "" -> None | x -> Some x - let stringToBson (value : string option) : BsonValue = match value with Some txt -> txt | None -> "" - - /// Mapping for Recurrence - module Recurrence = - let fromBson (value : BsonValue) = Recurrence.ofString value - let toBson (value : Recurrence) : BsonValue = Recurrence.toString value - - /// Mapping for RequestAction - module RequestAction = - let fromBson (value : BsonValue) = RequestAction.ofString value.AsString - let toBson (value : RequestAction) : BsonValue = RequestAction.toString value - - /// Mapping for RequestId - module RequestId = - let fromBson (value : BsonValue) = RequestId.ofString value.AsString - let toBson (value : RequestId) : BsonValue = RequestId.toString value - - /// Mapping for UserId - module UserId = - let fromBson (value : BsonValue) = UserId value.AsString - let toBson (value : UserId) : BsonValue = UserId.toString value + /// Mapping for NodaTime's Instant type + module Instant = + let fromBson (value : BsonValue) = Instant.FromUnixTimeMilliseconds value.AsInt64 + let toBson (value : Instant) : BsonValue = value.ToUnixTimeMilliseconds () - /// Set up the mapping - let register () = - BsonMapper.Global.RegisterType(Instant.toBson, Instant.fromBson) - BsonMapper.Global.RegisterType(Recurrence.toBson, Recurrence.fromBson) - BsonMapper.Global.RegisterType(RequestAction.toBson, RequestAction.fromBson) - BsonMapper.Global.RegisterType(RequestId.toBson, RequestId.fromBson) - BsonMapper.Global.RegisterType(Option.stringToBson, Option.stringFromBson) - BsonMapper.Global.RegisterType(UserId.toBson, UserId.fromBson) + /// Mapping for option types + module Option = + let stringFromBson (value : BsonValue) = match value.AsString with "" -> None | x -> Some x + let stringToBson (value : string option) : BsonValue = match value with Some txt -> txt | None -> "" + + /// Mapping for Recurrence + module Recurrence = + let fromBson (value : BsonValue) = Recurrence.ofString value + let toBson (value : Recurrence) : BsonValue = Recurrence.toString value + + /// Mapping for RequestAction + module RequestAction = + let fromBson (value : BsonValue) = RequestAction.ofString value.AsString + let toBson (value : RequestAction) : BsonValue = RequestAction.toString value + + /// Mapping for RequestId + module RequestId = + let fromBson (value : BsonValue) = RequestId.ofString value.AsString + let toBson (value : RequestId) : BsonValue = RequestId.toString value + + /// Mapping for UserId + module UserId = + let fromBson (value : BsonValue) = UserId value.AsString + let toBson (value : UserId) : BsonValue = UserId.toString value + + /// Set up the mapping + let register () = + BsonMapper.Global.RegisterType(Instant.toBson, Instant.fromBson) + BsonMapper.Global.RegisterType(Recurrence.toBson, Recurrence.fromBson) + BsonMapper.Global.RegisterType(RequestAction.toBson, RequestAction.fromBson) + BsonMapper.Global.RegisterType(RequestId.toBson, RequestId.fromBson) + BsonMapper.Global.RegisterType(Option.stringToBson, Option.stringFromBson) + BsonMapper.Global.RegisterType(UserId.toBson, UserId.fromBson) /// Code to be run at startup module Startup = - /// Ensure the database is set up - let ensureDb (db : LiteDatabase) = - db.requests.EnsureIndex (fun it -> it.userId) |> ignore - Mapping.register () + /// Ensure the database is set up + let ensureDb (db : LiteDatabase) = + db.requests.EnsureIndex (fun it -> it.userId) |> ignore + Mapping.register () /// Async wrappers for LiteDB, and request -> journal mappings [] module private Helpers = + + open System.Linq - open System.Linq + /// Convert a sequence to a list asynchronously (used for LiteDB IO) + let toListAsync<'T> (q : 'T seq) = + (q.ToList >> Task.FromResult) () - /// Convert a sequence to a list asynchronously (used for LiteDB IO) - let toListAsync<'T> (q : 'T seq) = - (q.ToList >> Task.FromResult) () + /// Convert a sequence to a list asynchronously (used for LiteDB IO) + let firstAsync<'T> (q : 'T seq) = + q.FirstOrDefault () |> Task.FromResult - /// Convert a sequence to a list asynchronously (used for LiteDB IO) - let firstAsync<'T> (q : 'T seq) = - q.FirstOrDefault () |> Task.FromResult - - /// Async wrapper around a request update - let doUpdate (db : LiteDatabase) (req : Request) = - db.requests.Update req |> ignore - Task.CompletedTask + /// Async wrapper around a request update + let doUpdate (db : LiteDatabase) (req : Request) = + db.requests.Update req |> ignore + Task.CompletedTask /// Retrieve a request, including its history and notes, by its ID and user ID let tryFullRequestById reqId userId (db : LiteDatabase) = backgroundTask { - 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 - } + 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 +} /// Add a history entry let addHistory reqId userId hist db = backgroundTask { - match! tryFullRequestById reqId userId db with - | Some req -> do! doUpdate db { req with history = hist :: req.history } - | None -> invalidOp $"{RequestId.toString reqId} not found" - } + match! tryFullRequestById reqId userId db with + | Some req -> do! doUpdate db { req with history = hist :: req.history } + | None -> invalidOp $"{RequestId.toString reqId} not found" +} /// Add a note let addNote reqId userId note db = backgroundTask { - match! tryFullRequestById reqId userId db with - | Some req -> do! doUpdate db { req with notes = note :: req.notes } - | None -> invalidOp $"{RequestId.toString reqId} not found" - } + match! tryFullRequestById reqId userId db with + | Some req -> do! doUpdate db { req with notes = note :: req.notes } + | None -> invalidOp $"{RequestId.toString reqId} not found" +} /// Add a request let addRequest (req : Request) (db : LiteDatabase) = - db.requests.Insert req |> ignore + 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 - return - reqs - |> Seq.map JournalRequest.ofRequestFull - |> Seq.filter (fun it -> it.lastStatus = Answered) - |> Seq.sortByDescending (fun it -> it.asOf) - |> List.ofSeq - } + let! reqs = db.requests.Find (Query.EQ ("userId", UserId.toString userId)) |> toListAsync + return + reqs + |> Seq.map JournalRequest.ofRequestFull + |> Seq.filter (fun it -> it.lastStatus = Answered) + |> Seq.sortByDescending (fun it -> it.asOf) + |> List.ofSeq +} /// Retrieve the user's current journal let journalByUserId userId (db : LiteDatabase) = backgroundTask { - let! jrnl = db.requests.Find (Query.EQ ("userId", UserId.toString userId)) |> toListAsync - return - jrnl - |> Seq.map JournalRequest.ofRequestLite - |> Seq.filter (fun it -> it.lastStatus <> Answered) - |> Seq.sortBy (fun it -> it.asOf) - |> List.ofSeq - } + let! jrnl = db.requests.Find (Query.EQ ("userId", UserId.toString userId)) |> toListAsync + return + jrnl + |> Seq.map JournalRequest.ofRequestLite + |> Seq.filter (fun it -> it.lastStatus <> Answered) + |> 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 -> r.snoozedUntil > now) - } + let! jrnl = journalByUserId userId db + return jrnl |> List.exists (fun r -> r.snoozedUntil > now) +} /// Retrieve a request by its ID and user ID (without notes and history) let tryRequestById reqId userId db = backgroundTask { - let! req = tryFullRequestById reqId userId db - return req |> Option.map (fun r -> { r with history = []; notes = [] }) - } + let! req = tryFullRequestById reqId userId db + return req |> Option.map (fun r -> { r with history = []; notes = [] }) +} /// Retrieve notes for a request by its ID and user ID let notesById reqId userId (db : LiteDatabase) = backgroundTask { - match! tryFullRequestById reqId userId db with | Some req -> return req.notes | None -> return [] - } + match! tryFullRequestById reqId userId db with | Some req -> return req.notes | None -> return [] +} /// Retrieve a journal request by its ID and user ID let tryJournalById reqId userId (db : LiteDatabase) = backgroundTask { - let! req = tryFullRequestById reqId userId db - return req |> Option.map JournalRequest.ofRequestLite - } + let! req = tryFullRequestById reqId userId db + return req |> Option.map JournalRequest.ofRequestLite +} /// Update the recurrence for a request let updateRecurrence reqId userId recurType db = backgroundTask { - match! tryFullRequestById reqId userId db with - | Some req -> do! doUpdate db { req with recurrence = recurType } - | None -> invalidOp $"{RequestId.toString reqId} not found" - } + match! tryFullRequestById reqId userId db with + | Some req -> do! doUpdate db { req with recurrence = recurType } + | None -> invalidOp $"{RequestId.toString reqId} not found" +} /// Update a snoozed request let updateSnoozed reqId userId until db = backgroundTask { - match! tryFullRequestById reqId userId db with - | Some req -> do! doUpdate db { req with snoozedUntil = until; showAfter = until } - | None -> invalidOp $"{RequestId.toString reqId} not found" - } + match! tryFullRequestById reqId userId db with + | Some req -> do! doUpdate db { req with snoozedUntil = until; showAfter = until } + | None -> invalidOp $"{RequestId.toString reqId} not found" +} /// Update the "show after" timestamp for a request let updateShowAfter reqId userId showAfter db = backgroundTask { - match! tryFullRequestById reqId userId db with - | Some req -> do! doUpdate db { req with showAfter = showAfter } - | None -> invalidOp $"{RequestId.toString reqId} not found" - } + match! tryFullRequestById reqId userId db with + | Some req -> do! doUpdate db { req with showAfter = showAfter } + | None -> invalidOp $"{RequestId.toString reqId} not found" +} diff --git a/src/MyPrayerJournal/Dates.fs b/src/MyPrayerJournal/Dates.fs index be8bc0c..a425b6d 100644 --- a/src/MyPrayerJournal/Dates.fs +++ b/src/MyPrayerJournal/Dates.fs @@ -5,39 +5,39 @@ module MyPrayerJournal.Dates open NodaTime type internal FormatDistanceToken = - | LessThanXMinutes - | XMinutes - | AboutXHours - | XHours - | XDays - | AboutXWeeks - | XWeeks - | AboutXMonths - | XMonths - | AboutXYears - | XYears - | OverXYears - | AlmostXYears + | LessThanXMinutes + | XMinutes + | AboutXHours + | XHours + | XDays + | AboutXWeeks + | XWeeks + | AboutXMonths + | XMonths + | AboutXYears + | XYears + | OverXYears + | AlmostXYears let internal locales = - let format = PrintfFormat string, unit, string, string> - Map.ofList [ - "en-US", Map.ofList [ - LessThanXMinutes, ("less than a minute", format "less than %i minutes") - XMinutes, ("a minute", format "%i minutes") - AboutXHours, ("about an hour", format "about %i hours") - XHours, ("an hour", format "%i hours") - XDays, ("a day", format "%i days") - AboutXWeeks, ("about a week", format "about %i weeks") - XWeeks, ("a week", format "%i weeks") - AboutXMonths, ("about a month", format "about %i months") - XMonths, ("a month", format "%i months") - AboutXYears, ("about a year", format "about %i years") - XYears, ("a year", format "%i years") - OverXYears, ("over a year", format "over %i years") - AlmostXYears, ("almost a year", format "almost %i years") + let format = PrintfFormat string, unit, string, string> + Map.ofList [ + "en-US", Map.ofList [ + LessThanXMinutes, ("less than a minute", format "less than %i minutes") + XMinutes, ("a minute", format "%i minutes") + AboutXHours, ("about an hour", format "about %i hours") + XHours, ("an hour", format "%i hours") + XDays, ("a day", format "%i days") + AboutXWeeks, ("about a week", format "about %i weeks") + XWeeks, ("a week", format "%i weeks") + AboutXMonths, ("about a month", format "about %i months") + XMonths, ("a month", format "%i months") + AboutXYears, ("about a year", format "about %i years") + XYears, ("a year", format "%i years") + OverXYears, ("over a year", format "over %i years") + AlmostXYears, ("almost a year", format "almost %i years") + ] ] - ] let aDay = 1_440. let almost2Days = 2_520. @@ -50,29 +50,29 @@ open System let fromJs ticks = DateTime.UnixEpoch + TimeSpan.FromTicks (ticks * 10_000L) 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 - let round (it : float) = Math.Round it |> int + let format (token, number) locale = + let labels = locales |> Map.find locale + match number with 1 -> fst labels[token] | _ -> sprintf (snd labels[token]) number + let round (it : float) = Math.Round it |> int - let diff = startDate - endDate - let minutes = Math.Abs diff.TotalMinutes - let formatToken = - let months = minutes / aMonth |> round - let years = months / 12 - match true with - | _ 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 < almost2Days -> 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 + let diff = startDate - endDate + let minutes = Math.Abs diff.TotalMinutes + let formatToken = + let months = minutes / aMonth |> round + let years = months / 12 + match true with + | _ 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 < almost2Days -> 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 - format formatToken "en-US" - |> match startDate > endDate with true -> sprintf "%s ago" | false -> sprintf "in %s" + format formatToken "en-US" + |> match startDate > endDate with true -> sprintf "%s ago" | false -> sprintf "in %s" diff --git a/src/MyPrayerJournal/Domain.fs b/src/MyPrayerJournal/Domain.fs index 85e5faf..6bd8aa1 100644 --- a/src/MyPrayerJournal/Domain.fs +++ b/src/MyPrayerJournal/Domain.fs @@ -9,205 +9,244 @@ open Cuid open NodaTime /// An identifier for a request -type RequestId = - | RequestId of Cuid +type RequestId = RequestId of Cuid /// Functions to manipulate request IDs module RequestId = - /// The string representation of the request ID - let toString = function RequestId x -> Cuid.toString x - /// Create a request ID from a string representation - let ofString = Cuid >> RequestId + + /// The string representation of the request ID + let toString = function RequestId x -> Cuid.toString x + + /// Create a request ID from a string representation + let ofString = Cuid >> RequestId /// The identifier of a user (the "sub" part of the JWT) -type UserId = - | UserId of string +type UserId = UserId of string /// Functions to manipulate user IDs module UserId = - /// The string representation of the user ID - let toString = function UserId x -> x + + /// The string representation of the user ID + let toString = function UserId x -> x /// How frequently a request should reappear after it is marked "Prayed" type Recurrence = - | Immediate - | Hours of int16 - | Days of int16 - | Weeks of int16 + /// A request should reappear immediately at the bottom of the list + | Immediate + /// A request should reappear in the given number of hours + | Hours of int16 + /// A request should reappear in the given number of days + | Days of int16 + /// A request should reappear in the given number of weeks (7-day increments) + | Weeks of int16 /// Functions to manipulate recurrences module Recurrence = - /// Create a string representation of a recurrence - let toString = - function - | Immediate -> "Immediate" - | Hours h -> $"{h} Hours" - | Days d -> $"{d} Days" - | Weeks w -> $"{w} Weeks" - /// Create a recurrence value from a string - let ofString = - function - | "Immediate" -> Immediate - | it when it.Contains " " -> - let parts = it.Split " " - let length = Convert.ToInt16 parts[0] - match parts[1] with - | "Hours" -> Hours length - | "Days" -> Days length - | "Weeks" -> Weeks length - | _ -> invalidOp $"{parts[1]} is not a valid recurrence" - | it -> invalidOp $"{it} is not a valid recurrence" - /// An hour's worth of seconds - let private oneHour = 3_600L - /// The duration of the recurrence (in milliseconds) - let duration = - function - | Immediate -> 0L - | Hours h -> int64 h * oneHour - | Days d -> int64 d * oneHour * 24L - | Weeks w -> int64 w * oneHour * 24L * 7L + + /// Create a string representation of a recurrence + let toString = + function + | Immediate -> "Immediate" + | Hours h -> $"{h} Hours" + | Days d -> $"{d} Days" + | Weeks w -> $"{w} Weeks" + + /// Create a recurrence value from a string + let ofString = + function + | "Immediate" -> Immediate + | it when it.Contains " " -> + let parts = it.Split " " + let length = Convert.ToInt16 parts[0] + match parts[1] with + | "Hours" -> Hours length + | "Days" -> Days length + | "Weeks" -> Weeks length + | _ -> invalidOp $"{parts[1]} is not a valid recurrence" + | it -> invalidOp $"{it} is not a valid recurrence" + + /// An hour's worth of seconds + let private oneHour = 3_600L + + /// The duration of the recurrence (in milliseconds) + let duration = + function + | Immediate -> 0L + | Hours h -> int64 h * oneHour + | Days d -> int64 d * oneHour * 24L + | Weeks w -> int64 w * oneHour * 24L * 7L /// The action taken on a request as part of a history entry type RequestAction = - | Created - | Prayed - | Updated - | Answered + | Created + | Prayed + | Updated + | Answered /// History is a record of action taken on a prayer request, including updates to its text [] -type History = { - /// The time when this history entry was made - asOf : Instant - /// The status for this history entry - status : RequestAction - /// The text of the update, if applicable - text : string option - } +type History = + { /// The time when this history entry was made + asOf : Instant + + /// The status for this history entry + status : RequestAction + + /// The text of the update, if applicable + text : string option + } + /// Note is a note regarding a prayer request that does not result in an update to its text [] -type Note = { - /// The time when this note was made - asOf : Instant - /// The text of the notes - notes : string - } +type Note = + { /// The time when this note was made + asOf : Instant + + /// The text of the notes + notes : string + } + /// Request is the identifying record for a prayer request [] -type Request = { - /// The ID of the request - id : RequestId - /// The time this request was initially entered - 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 : Instant - /// The time at which this request should reappear in the user's journal by recurrence - showAfter : Instant - /// The recurrence for this request - recurrence : Recurrence - /// The history entries for this request - history : History list - /// The notes for this request - notes : Note list - } -with - /// An empty request - static member empty = - { id = Cuid.generate () |> RequestId - enteredOn = Instant.MinValue - userId = UserId "" - snoozedUntil = Instant.MinValue - showAfter = Instant.MinValue - recurrence = Immediate - history = [] - notes = [] - } +type Request = + { /// The ID of the request + id : RequestId + + /// The time this request was initially entered + 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 : Instant + + /// The time at which this request should reappear in the user's journal by recurrence + showAfter : Instant + + /// The recurrence for this request + recurrence : Recurrence + + /// The history entries for this request + history : History list + + /// The notes for this request + notes : Note list + } + +/// Functions to support requests +module Request = + + /// An empty request + let empty = + { id = Cuid.generate () |> RequestId + enteredOn = Instant.MinValue + userId = UserId "" + snoozedUntil = Instant.MinValue + showAfter = Instant.MinValue + recurrence = Immediate + history = [] + notes = [] + } + /// JournalRequest is the form of a prayer request returned for the request journal display. It also contains /// properties that may be filled for history and notes. [] -type JournalRequest = { - /// The ID of the request (just the CUID part) - requestId : RequestId - /// The ID of the user to whom the request belongs - userId : UserId - /// The current text of the request - text : string - /// The last time action was taken on the request - asOf : Instant - /// The last status for the request - lastStatus : RequestAction - /// The time that this request should reappear in the user's journal - snoozedUntil : Instant - /// The time after which this request should reappear in the user's journal by configured recurrence - showAfter : Instant - /// The recurrence for this request - recurrence : Recurrence - /// History entries for the request - history : History list - /// Note entries for the request - notes : Note list - } +type JournalRequest = + { /// The ID of the request (just the CUID part) + requestId : RequestId + + /// The ID of the user to whom the request belongs + userId : UserId + + /// The current text of the request + text : string + + /// The last time action was taken on the request + asOf : Instant + + /// The last status for the request + lastStatus : RequestAction + + /// The time that this request should reappear in the user's journal + snoozedUntil : Instant + + /// The time after which this request should reappear in the user's journal by configured recurrence + showAfter : Instant + + /// The recurrence for this request + recurrence : Recurrence + + /// History entries for the request + history : History list + + /// Note entries for the request + notes : Note list + } /// Functions to manipulate journal requests 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 -> 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 -> it.asOf) - |> List.tryHead - |> Option.map (fun h -> Option.get h.text) - |> Option.defaultValue "" - 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 - recurrence = req.recurrence - history = [] - notes = [] - } + /// 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 -> 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 -> it.asOf) + |> List.tryHead + |> Option.map (fun h -> Option.get h.text) + |> Option.defaultValue "" + 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 + recurrence = req.recurrence + history = [] + notes = [] + } - /// Same as `ofRequestLite`, but with notes and history - let ofRequestFull req = - { ofRequestLite req with - history = req.history - notes = req.notes - } + /// Same as `ofRequestLite`, but with notes and history + let ofRequestFull req = + { ofRequestLite req with + history = req.history + notes = req.notes + } /// Functions to manipulate request actions module RequestAction = - /// Create a string representation of an action - let toString = - function - | Created -> "Created" - | Prayed -> "Prayed" - | Updated -> "Updated" - | Answered -> "Answered" - /// Create a RequestAction from a string - let ofString = - function - | "Created" -> Created - | "Prayed" -> Prayed - | "Updated" -> Updated - | "Answered" -> Answered - | it -> invalidOp $"Bad request action {it}" - /// Determine if a history's status is `Created` - let isCreated hist = hist.status = Created - /// Determine if a history's status is `Prayed` - let isPrayed hist = hist.status = Prayed - /// Determine if a history's status is `Answered` - let isAnswered hist = hist.status = Answered + + /// Create a string representation of an action + let toString = + function + | Created -> "Created" + | Prayed -> "Prayed" + | Updated -> "Updated" + | Answered -> "Answered" + + /// Create a RequestAction from a string + let ofString = + function + | "Created" -> Created + | "Prayed" -> Prayed + | "Updated" -> Updated + | "Answered" -> Answered + | it -> invalidOp $"Bad request action {it}" + + /// Determine if a history's status is `Created` + let isCreated hist = hist.status = Created + + /// Determine if a history's status is `Prayed` + let isPrayed hist = hist.status = Prayed + + /// Determine if a history's status is `Answered` + let isAnswered hist = hist.status = Answered diff --git a/src/MyPrayerJournal/Handlers.fs b/src/MyPrayerJournal/Handlers.fs index a0bab46..e8eee7d 100644 --- a/src/MyPrayerJournal/Handlers.fs +++ b/src/MyPrayerJournal/Handlers.fs @@ -16,212 +16,215 @@ open NodaTime [] module private LogOnHelpers = - /// Log on, optionally specifying a redirected URL once authentication is complete - let logOn url : HttpHandler = - fun next ctx -> backgroundTask { - match url with - | Some it -> - do! ctx.ChallengeAsync ("Auth0", AuthenticationProperties (RedirectUri = it)) - return! next ctx - | None -> return! challenge "Auth0" next ctx - } + /// Log on, optionally specifying a redirected URL once authentication is complete + let logOn url : HttpHandler = fun next ctx -> backgroundTask { + match url with + | Some it -> + do! ctx.ChallengeAsync ("Auth0", AuthenticationProperties (RedirectUri = it)) + return! next ctx + | None -> return! challenge "Auth0" next ctx + } + /// Handlers for error conditions module Error = - open Microsoft.Extensions.Logging - open System.Threading.Tasks + open Microsoft.Extensions.Logging + open System.Threading.Tasks - /// Handle errors - let error (ex : Exception) (log : ILogger) = - log.LogError (EventId(), ex, "An unhandled exception has occurred while executing the request.") - clearResponse - >=> setStatusCode 500 - >=> setHttpHeader "X-Toast" $"error|||{ex.GetType().Name}: {ex.Message}" - >=> text ex.Message + /// Handle errors + let error (ex : Exception) (log : ILogger) = + log.LogError (EventId (), ex, "An unhandled exception has occurred while executing the request.") + clearResponse + >=> setStatusCode 500 + >=> setHttpHeader "X-Toast" $"error|||{ex.GetType().Name}: {ex.Message}" + >=> text ex.Message - /// Handle unauthorized actions, redirecting to log on for GETs, otherwise returning a 401 Not Authorized response - let notAuthorized : HttpHandler = - fun next ctx -> - (next, ctx) - ||> match ctx.Request.Method with - | "GET" -> logOn None - | _ -> setStatusCode 401 >=> fun _ _ -> Task.FromResult None + /// Handle unauthorized actions, redirecting to log on for GETs, otherwise returning a 401 Not Authorized response + let notAuthorized : HttpHandler = fun next ctx -> + (next, ctx) + ||> match ctx.Request.Method with + | "GET" -> logOn None + | _ -> setStatusCode 401 >=> fun _ _ -> Task.FromResult None - /// Handle 404s from the API, sending known URL paths to the Vue app so that they can be handled there - let notFound : HttpHandler = - setStatusCode 404 >=> text "Not found" + /// Handle 404s from the API, sending known URL paths to the Vue app so that they can be handled there + let notFound : HttpHandler = + setStatusCode 404 >=> text "Not found" /// Handler helpers [] module private Helpers = - open LiteDB - open Microsoft.Extensions.Logging - open Microsoft.Net.Http.Headers + open LiteDB + open Microsoft.Extensions.Logging + open Microsoft.Net.Http.Headers - let debug (ctx : HttpContext) message = - let fac = ctx.GetService() - let log = fac.CreateLogger "Debug" - log.LogInformation message + let debug (ctx : HttpContext) message = + let fac = ctx.GetService() + let log = fac.CreateLogger "Debug" + log.LogInformation message - /// Get the LiteDB database - let db (ctx : HttpContext) = ctx.GetService() + /// Get the LiteDB database + let db (ctx : HttpContext) = ctx.GetService() - /// Get the user's "sub" claim - let user (ctx : HttpContext) = - ctx.User - |> Option.ofObj - |> Option.map (fun user -> user.Claims |> Seq.tryFind (fun u -> u.Type = ClaimTypes.NameIdentifier)) - |> Option.flatten - |> Option.map (fun claim -> claim.Value) + /// Get the user's "sub" claim + let user (ctx : HttpContext) = + ctx.User + |> Option.ofObj + |> Option.map (fun user -> user.Claims |> Seq.tryFind (fun u -> u.Type = ClaimTypes.NameIdentifier)) + |> Option.flatten + |> Option.map (fun claim -> claim.Value) - /// Get the current user's ID - // NOTE: this may raise if you don't run the request through the requiresAuthentication handler first - let userId ctx = - (user >> Option.get) ctx |> UserId + /// Get the current user's ID + // NOTE: this may raise if you don't run the request through the requiresAuthentication handler first + let userId ctx = + (user >> Option.get) ctx |> UserId - /// Get the system clock - let clock (ctx : HttpContext) = - ctx.GetService () + /// Get the system clock + let clock (ctx : HttpContext) = + ctx.GetService () - /// Get the current instant - let now ctx = - (clock ctx).GetCurrentInstant () + /// Get the current instant + let now ctx = + (clock ctx).GetCurrentInstant () - /// Return a 201 CREATED response - let created = - setStatusCode 201 + /// Return a 201 CREATED response + let created = + setStatusCode 201 - /// Return a 201 CREATED response with the location header set for the created resource - let createdAt url : HttpHandler = - fun next ctx -> - ($"{ctx.Request.Scheme}://{ctx.Request.Host.Value}{url}" |> setHttpHeader HeaderNames.Location - >=> created) next ctx + /// Return a 201 CREATED response with the location header set for the created resource + let createdAt url : HttpHandler = fun next ctx -> + Successful.CREATED + ($"{ctx.Request.Scheme}://{ctx.Request.Host.Value}{url}" |> setHttpHeader HeaderNames.Location) next ctx - /// Return a 303 SEE OTHER response (forces a GET on the redirected URL) - let seeOther (url : string) = - noResponseCaching >=> setStatusCode 303 >=> setHttpHeader "Location" url + /// Return a 303 SEE OTHER response (forces a GET on the redirected URL) + let seeOther (url : string) = + noResponseCaching >=> setStatusCode 303 >=> setHttpHeader "Location" url - /// Render a component result - let renderComponent nodes : HttpHandler = - noResponseCaching - >=> fun _ ctx -> backgroundTask { - return! ctx.WriteHtmlStringAsync (ViewEngine.RenderView.AsString.htmlNodes nodes) - } + /// Render a component result + let renderComponent nodes : HttpHandler = + noResponseCaching + >=> fun _ ctx -> backgroundTask { + return! ctx.WriteHtmlStringAsync (ViewEngine.RenderView.AsString.htmlNodes nodes) + } - open Views.Layout + open Views.Layout - /// Create a page rendering context - let pageContext (ctx : HttpContext) pageTitle content = backgroundTask { - let! hasSnoozed = backgroundTask { - match user ctx with - | Some _ -> return! Data.hasSnoozed (userId ctx) (now ctx) (db ctx) - | None -> return false - } - return { - isAuthenticated = (user >> Option.isSome) ctx - hasSnoozed = hasSnoozed - currentUrl = ctx.Request.Path.Value - pageTitle = pageTitle - content = content - } + /// Create a page rendering context + let pageContext (ctx : HttpContext) pageTitle content = backgroundTask { + let! hasSnoozed = backgroundTask { + match user ctx with + | Some _ -> return! Data.hasSnoozed (userId ctx) (now ctx) (db ctx) + | None -> return false + } + return { + isAuthenticated = (user >> Option.isSome) ctx + hasSnoozed = hasSnoozed + currentUrl = ctx.Request.Path.Value + pageTitle = pageTitle + content = content + } } - /// Composable handler to write a view to the output - let writeView view : HttpHandler = - fun _ ctx -> backgroundTask { - return! ctx.WriteHtmlViewAsync view - } + /// Composable handler to write a view to the output + let writeView view : HttpHandler = fun _ ctx -> backgroundTask { + return! ctx.WriteHtmlViewAsync view + } + + + /// Hold messages across redirects + module Messages = - /// Hold messages across redirects - module Messages = + /// The messages being held + let mutable private messages : Map = Map.empty - /// The messages being held - let mutable private messages : Map = Map.empty + /// Locked update to prevent updates by multiple threads + let private upd8 = obj () - /// Locked update to prevent updates by multiple threads - let private upd8 = obj () + /// Push a new message into the list + let push ctx message url = lock upd8 (fun () -> + messages <- messages.Add (ctx |> (user >> Option.get), (message, url))) - /// Push a new message into the list - let push ctx message url = lock upd8 (fun () -> - messages <- messages.Add (ctx |> (user >> Option.get), (message, url))) + /// Add a success message header to the response + let pushSuccess ctx message url = + push ctx $"success|||{message}" url + + /// Pop the messages for the given user + let pop userId = lock upd8 (fun () -> + let msg = messages.TryFind userId + msg |> Option.iter (fun _ -> messages <- messages.Remove userId) + msg) + + /// Send a partial result if this is not a full page load (does not append no-cache headers) + let partialStatic (pageTitle : string) content : HttpHandler = fun next ctx -> backgroundTask { + let isPartial = ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh + let! pageCtx = pageContext ctx pageTitle content + let view = (match isPartial with true -> partial | false -> view) pageCtx + return! + (next, ctx) + ||> match user ctx with + | Some u -> + match Messages.pop u with + | Some (msg, url) -> setHttpHeader "X-Toast" msg >=> withHxPush url >=> 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 - let pushSuccess ctx message url = - push ctx $"success|||{message}" url - - /// Pop the messages for the given user - let pop userId = lock upd8 (fun () -> - let msg = messages.TryFind userId - msg |> Option.iter (fun _ -> messages <- messages.Remove userId) - msg) - - /// Send a partial result if this is not a full page load (does not append no-cache headers) - let partialStatic (pageTitle : string) content : HttpHandler = - fun next ctx -> backgroundTask { - let isPartial = ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh - let! pageCtx = pageContext ctx pageTitle content - let view = (match isPartial with true -> partial | false -> view) pageCtx - return! - (next, ctx) - ||> match user ctx with - | Some u -> - match Messages.pop u with - | Some (msg, url) -> setHttpHeader "X-Toast" msg >=> withHxPush url >=> 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 - let withSuccessMessage : string -> HttpHandler = - sprintf "success|||%s" >> setHttpHeader "X-Toast" + let withSuccessMessage : string -> HttpHandler = + sprintf "success|||%s" >> setHttpHeader "X-Toast" - /// Hide a modal window when the response is sent - let hideModal (name : string) : HttpHandler = - setHttpHeader "X-Hide-Modal" name + /// Hide a modal window when the response is sent + let hideModal (name : string) : HttpHandler = + setHttpHeader "X-Hide-Modal" name /// Strongly-typed models for post requests module Models = - /// An additional note - [] - type NoteEntry = { - /// The notes being added - notes : string - } + /// An additional note + [] + type NoteEntry = + { /// The notes being added + notes : string + } + + /// A prayer request + [] + type Request = + { /// The ID of the request + requestId : string + + /// Where to redirect after saving + returnTo : string + + /// The text of the request + requestText : string + + /// The additional status to record + status : string option + + /// The recurrence type + recurType : string + + /// The recurrence count + recurCount : int16 option + + /// The recurrence interval + recurInterval : string option + } - /// A prayer request - [] - type Request = { - /// The ID of the request - requestId : string - /// Where to redirect after saving - returnTo : string - /// The text of the request - requestText : string - /// The additional status to record - status : string option - /// The recurrence type - recurType : string - /// The recurrence count - recurCount : int16 option - /// The recurrence interval - recurInterval : string option - } - - /// The date until which a request should not appear in the journal - [] - type SnoozeUntil = { - /// The date (YYYY-MM-DD) at which the request should reappear - until : string - } + /// The date until which a request should not appear in the journal + [] + type SnoozeUntil = + { /// The date (YYYY-MM-DD) at which the request should reappear + until : string + } open MyPrayerJournal.Data.Extensions @@ -230,372 +233,329 @@ open NodaTime.Text /// Handlers for less-than-full-page HTML requests module Components = - // GET /components/journal-items - let journalItems : HttpHandler = - requiresAuthentication Error.notAuthorized - >=> fun next ctx -> backgroundTask { - let now = now ctx - let! jrnl = Data.journalByUserId (userId ctx) (db 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/journal-items + let journalItems : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask { + let now = now ctx + let! jrnl = Data.journalByUserId (userId ctx) (db 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] - let requestItem reqId : HttpHandler = - 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 (now ctx) req ] next ctx - | None -> return! Error.notFound next ctx - } + // GET /components/request-item/[req-id] + let requestItem reqId : HttpHandler = 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 (now ctx) req ] 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]/add-notes + let addNotes requestId : HttpHandler = + requiresAuthentication Error.notAuthorized + >=> renderComponent (Views.Journal.notesEdit (RequestId.ofString requestId)) - // GET /components/request/[req-id]/notes - let notes requestId : HttpHandler = - requiresAuthentication Error.notAuthorized - >=> fun next ctx -> backgroundTask { - let! notes = Data.notesById (RequestId.ofString requestId) (userId ctx) (db ctx) - return! renderComponent (Views.Request.notes (now ctx) notes) next ctx - } + // GET /components/request/[req-id]/notes + let notes requestId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask { + let! notes = Data.notesById (RequestId.ofString requestId) (userId ctx) (db ctx) + return! renderComponent (Views.Request.notes (now ctx) notes) next ctx + } - // GET /components/request/[req-id]/snooze - let snooze requestId : HttpHandler = - requiresAuthentication Error.notAuthorized - >=> renderComponent [ RequestId.ofString requestId |> Views.Journal.snooze ] + // GET /components/request/[req-id]/snooze + let snooze requestId : HttpHandler = + requiresAuthentication Error.notAuthorized + >=> renderComponent [ RequestId.ofString requestId |> Views.Journal.snooze ] /// / URL module Home = - // GET / - let home : HttpHandler = - partialStatic "Welcome!" Views.Layout.home + // GET / + let home : HttpHandler = + partialStatic "Welcome!" Views.Layout.home /// /journal URL module Journal = - // GET /journal - let journal : HttpHandler = - requiresAuthentication Error.notAuthorized - >=> fun next ctx -> backgroundTask { - let usr = - ctx.User.Claims - |> Seq.tryFind (fun c -> c.Type = ClaimTypes.GivenName) - |> Option.map (fun c -> c.Value) - |> Option.defaultValue "Your" - let title = usr |> match usr with "Your" -> sprintf "%s" | _ -> sprintf "%s's" - return! partial $"{title} Prayer Journal" (Views.Journal.journal usr) next ctx + // GET /journal + let journal : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask { + let usr = + ctx.User.Claims + |> Seq.tryFind (fun c -> c.Type = ClaimTypes.GivenName) + |> Option.map (fun c -> c.Value) + |> Option.defaultValue "Your" + let title = usr |> match usr with "Your" -> sprintf "%s" | _ -> sprintf "%s's" + return! partial $"{title} Prayer Journal" (Views.Journal.journal usr) next ctx } /// /legal URLs module Legal = - // GET /legal/privacy-policy - let privacyPolicy : HttpHandler = - partialStatic "Privacy Policy" Views.Legal.privacyPolicy + // GET /legal/privacy-policy + let privacyPolicy : HttpHandler = + partialStatic "Privacy Policy" Views.Legal.privacyPolicy - // GET /legal/terms-of-service - let termsOfService : HttpHandler = - partialStatic "Terms of Service" Views.Legal.termsOfService + // GET /legal/terms-of-service + let termsOfService : HttpHandler = + partialStatic "Terms of Service" Views.Legal.termsOfService /// /api/request and /request(s) URLs module Request = - // GET /request/[req-id]/edit - let edit requestId : HttpHandler = - requiresAuthentication Error.notAuthorized - >=> fun next ctx -> backgroundTask { - let returnTo = - match ctx.Request.Headers.Referer.[0] with - | it when it.EndsWith "/active" -> "active" - | it when it.EndsWith "/snoozed" -> "snoozed" - | _ -> "journal" - match requestId with - | "new" -> - return! partial "Add Prayer 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 -> - 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 - } + // GET /request/[req-id]/edit + let edit requestId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask { + let returnTo = + match ctx.Request.Headers.Referer[0] with + | it when it.EndsWith "/active" -> "active" + | it when it.EndsWith "/snoozed" -> "snoozed" + | _ -> "journal" + match requestId with + | "new" -> + return! partial "Add Prayer 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 -> + 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 - let prayed requestId : HttpHandler = - requiresAuthentication Error.notAuthorized - >=> fun next ctx -> backgroundTask { - let db = db ctx - let usrId = userId ctx - let reqId = RequestId.ofString requestId - match! Data.tryRequestById reqId usrId db with - | Some req -> - let now = now ctx - do! Data.addHistory reqId usrId { asOf = now; status = Prayed; text = None } db - let nextShow = - match Recurrence.duration req.recurrence with - | 0L -> Instant.MinValue - | duration -> now.Plus (Duration.FromSeconds duration) - 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 - } + // PATCH /request/[req-id]/prayed + let prayed requestId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask { + let db = db ctx + let usrId = userId ctx + let reqId = RequestId.ofString requestId + match! Data.tryRequestById reqId usrId db with + | Some req -> + let now = now ctx + do! Data.addHistory reqId usrId { asOf = now; status = Prayed; text = None } db + let nextShow = + match Recurrence.duration req.recurrence with + | 0L -> Instant.MinValue + | duration -> now.Plus (Duration.FromSeconds duration) + 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 + } - /// POST /request/[req-id]/note - let addNote requestId : HttpHandler = - requiresAuthentication Error.notAuthorized - >=> fun next ctx -> backgroundTask { - let db = db ctx - let usrId = userId ctx - let reqId = RequestId.ofString requestId - match! Data.tryRequestById reqId usrId db with - | Some _ -> - let! notes = ctx.BindFormAsync () - 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 - } + /// POST /request/[req-id]/note + let addNote requestId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask { + let db = db ctx + let usrId = userId ctx + let reqId = RequestId.ofString requestId + match! Data.tryRequestById reqId usrId db with + | Some _ -> + let! notes = ctx.BindFormAsync () + 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 + } - // GET /requests/active - let active : HttpHandler = - requiresAuthentication Error.notAuthorized - >=> fun next ctx -> backgroundTask { - let! reqs = Data.journalByUserId (userId ctx) (db ctx) - return! partial "Active Requests" (Views.Request.active (now ctx) reqs) next ctx - } + // GET /requests/active + let active : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask { + let! reqs = Data.journalByUserId (userId ctx) (db ctx) + return! partial "Active Requests" (Views.Request.active (now ctx) reqs) next ctx + } - // GET /requests/snoozed - let snoozed : HttpHandler = - requiresAuthentication Error.notAuthorized - >=> fun next ctx -> backgroundTask { - let! reqs = Data.journalByUserId (userId ctx) (db 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/snoozed + let snoozed : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask { + let! reqs = Data.journalByUserId (userId ctx) (db 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 - let answered : HttpHandler = - requiresAuthentication Error.notAuthorized - >=> fun next ctx -> backgroundTask { - let! reqs = Data.answeredRequests (userId ctx) (db ctx) - return! partial "Answered Requests" (Views.Request.answered (now ctx) reqs) next ctx - } + // GET /requests/answered + let answered : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask { + let! reqs = Data.answeredRequests (userId ctx) (db ctx) + return! partial "Answered Requests" (Views.Request.answered (now ctx) reqs) next ctx + } - // GET /api/request/[req-id] - let get requestId : HttpHandler = - requiresAuthentication Error.notAuthorized - >=> fun next ctx -> backgroundTask { - 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 + let getFull requestId : HttpHandler = 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 (clock ctx) req) next ctx + | None -> return! Error.notFound next ctx + } - // GET /request/[req-id]/full - let getFull requestId : HttpHandler = - 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 (clock ctx) req) next ctx - | None -> return! Error.notFound next ctx - } + // PATCH /request/[req-id]/show + let show requestId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask { + let db = db ctx + let usrId = userId ctx + let reqId = RequestId.ofString requestId + match! Data.tryRequestById reqId usrId db with + | Some _ -> + 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 + } - // PATCH /request/[req-id]/show - let show requestId : HttpHandler = - requiresAuthentication Error.notAuthorized - >=> fun next ctx -> backgroundTask { - let db = db ctx - let usrId = userId ctx - let reqId = RequestId.ofString requestId - match! Data.tryRequestById reqId usrId db with - | Some _ -> - 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 - } + // PATCH /request/[req-id]/snooze + let snooze requestId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask { + let db = db ctx + let usrId = userId ctx + let reqId = RequestId.ofString requestId + match! Data.tryRequestById reqId usrId db with + | Some _ -> + let! until = ctx.BindFormAsync () + 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}" + >=> hideModal "snooze" + >=> Components.journalItems) next ctx + | None -> return! Error.notFound next ctx + } - // PATCH /request/[req-id]/snooze - let snooze requestId : HttpHandler = - requiresAuthentication Error.notAuthorized - >=> fun next ctx -> backgroundTask { - let db = db ctx - let usrId = userId ctx - let reqId = RequestId.ofString requestId - match! Data.tryRequestById reqId usrId db with - | Some _ -> - let! until = ctx.BindFormAsync () - 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}" - >=> hideModal "snooze" - >=> Components.journalItems) next ctx - | None -> return! Error.notFound next ctx - } - - // PATCH /request/[req-id]/cancel-snooze - let cancelSnooze requestId : HttpHandler = - requiresAuthentication Error.notAuthorized - >=> fun next ctx -> backgroundTask { - let db = db ctx - let usrId = userId ctx - let reqId = RequestId.ofString requestId - match! Data.tryRequestById reqId usrId db with - | Some _ -> - 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 - } + // PATCH /request/[req-id]/cancel-snooze + let cancelSnooze requestId : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask { + let db = db ctx + let usrId = userId ctx + let reqId = RequestId.ofString requestId + match! Data.tryRequestById reqId usrId db with + | Some _ -> + 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 + } - /// Derive a recurrence from its representation in the form - let private parseRecurrence (form : Models.Request) = - match form.recurInterval with Some x -> $"{defaultArg form.recurCount 0s} {x}" | None -> "Immediate" - |> Recurrence.ofString + /// Derive a recurrence from its representation in the form + let private parseRecurrence (form : Models.Request) = + match form.recurInterval with Some x -> $"{defaultArg form.recurCount 0s} {x}" | None -> "Immediate" + |> Recurrence.ofString - // POST /request - let add : HttpHandler = - requiresAuthentication Error.notAuthorized - >=> fun next ctx -> backgroundTask { - let! form = ctx.BindModelAsync () - let db = db ctx - let usrId = userId ctx - let now = now ctx - let req = - { Request.empty with - userId = usrId - enteredOn = now - showAfter = Instant.MinValue - recurrence = parseRecurrence form - history = [ - { asOf = now - status = Created - text = Some form.requestText - } - ] - } - Data.addRequest req db - do! db.saveChanges () - Messages.pushSuccess ctx "Added prayer request" "/journal" - return! seeOther "/journal" next ctx - } + // POST /request + let add : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask { + let! form = ctx.BindModelAsync () + let db = db ctx + let usrId = userId ctx + let now = now ctx + let req = + { Request.empty with + userId = usrId + enteredOn = now + showAfter = Instant.MinValue + recurrence = parseRecurrence form + history = [ + { asOf = now + status = Created + text = Some form.requestText + } + ] + } + Data.addRequest req db + do! db.saveChanges () + Messages.pushSuccess ctx "Added prayer request" "/journal" + return! seeOther "/journal" next ctx + } - // PATCH /request - let update : HttpHandler = - requiresAuthentication Error.notAuthorized - >=> fun next ctx -> backgroundTask { - let! form = ctx.BindModelAsync () - let db = db ctx - let usrId = userId ctx - match! Data.tryJournalById (RequestId.ofString form.requestId) usrId db with - | Some req -> - // update recurrence if changed - let recur = parseRecurrence form - match recur = req.recurrence with - | true -> () - | false -> - do! Data.updateRecurrence req.requestId usrId recur db - match recur with - | 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 = now ctx; status = (Option.get >> RequestAction.ofString) form.status; text = text } db - do! db.saveChanges () - let nextUrl = - match form.returnTo with - | "active" -> "/requests/active" - | "snoozed" -> "/requests/snoozed" - | _ (* "journal" *) -> "/journal" - Messages.pushSuccess ctx "Prayer request updated successfully" nextUrl - return! seeOther nextUrl next ctx - | None -> return! Error.notFound next ctx - } + // PATCH /request + let update : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> backgroundTask { + let! form = ctx.BindModelAsync () + let db = db ctx + let usrId = userId ctx + match! Data.tryJournalById (RequestId.ofString form.requestId) usrId db with + | Some req -> + // update recurrence if changed + let recur = parseRecurrence form + match recur = req.recurrence with + | true -> () + | false -> + do! Data.updateRecurrence req.requestId usrId recur db + match recur with + | 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 = now ctx; status = (Option.get >> RequestAction.ofString) form.status; text = text } db + do! db.saveChanges () + let nextUrl = + match form.returnTo with + | "active" -> "/requests/active" + | "snoozed" -> "/requests/snoozed" + | _ (* "journal" *) -> "/journal" + Messages.pushSuccess ctx "Prayer request updated successfully" nextUrl + return! seeOther nextUrl next ctx + | None -> return! Error.notFound next ctx + } /// Handlers for /user URLs module User = - open Microsoft.AspNetCore.Authentication.Cookies + open Microsoft.AspNetCore.Authentication.Cookies - // GET /user/log-on - let logOn : HttpHandler = - logOn (Some "/journal") + // GET /user/log-on + let logOn : HttpHandler = + logOn (Some "/journal") - // GET /user/log-off - let logOff : HttpHandler = - requiresAuthentication Error.notAuthorized - >=> fun next ctx -> task { - do! ctx.SignOutAsync ("Auth0", AuthenticationProperties (RedirectUri = "/")) - do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme - return! next ctx + // GET /user/log-off + let logOff : HttpHandler = requiresAuthentication Error.notAuthorized >=> fun next ctx -> task { + do! ctx.SignOutAsync ("Auth0", AuthenticationProperties (RedirectUri = "/")) + do! ctx.SignOutAsync CookieAuthenticationDefaults.AuthenticationScheme + return! next ctx } open Giraffe.EndpointRouting /// The routes for myPrayerJournal -let routes = - [ GET_HEAD [ route "/" Home.home ] +let routes = [ + GET_HEAD [ route "/" Home.home ] subRoute "/components/" [ - GET_HEAD [ - route "journal-items" Components.journalItems - routef "request/%s/add-notes" Components.addNotes - routef "request/%s/item" Components.requestItem - routef "request/%s/notes" Components.notes - routef "request/%s/snooze" Components.snooze + GET_HEAD [ + route "journal-items" Components.journalItems + routef "request/%s/add-notes" Components.addNotes + routef "request/%s/item" Components.requestItem + routef "request/%s/notes" Components.notes + routef "request/%s/snooze" Components.snooze ] - ] + ] GET_HEAD [ route "/journal" Journal.journal ] subRoute "/legal/" [ - GET_HEAD [ - route "privacy-policy" Legal.privacyPolicy - route "terms-of-service" Legal.termsOfService + GET_HEAD [ + route "privacy-policy" Legal.privacyPolicy + route "terms-of-service" Legal.termsOfService ] - ] - subRoute "/request" [ - GET_HEAD [ - routef "/%s/edit" Request.edit - routef "/%s/full" Request.getFull - route "s/active" Request.active - route "s/answered" Request.answered - route "s/snoozed" Request.snoozed - ] - PATCH [ - route "" Request.update - routef "/%s/cancel-snooze" Request.cancelSnooze - routef "/%s/prayed" Request.prayed - routef "/%s/show" Request.show - routef "/%s/snooze" Request.snooze - ] - POST [ - route "" Request.add - routef "/%s/note" Request.addNote - ] - ] - subRoute "/user/" [ - GET_HEAD [ - route "log-off" User.logOff - route "log-on" User.logOn - ] - ] ] + subRoute "/request" [ + GET_HEAD [ + routef "/%s/edit" Request.edit + routef "/%s/full" Request.getFull + route "s/active" Request.active + route "s/answered" Request.answered + route "s/snoozed" Request.snoozed + ] + PATCH [ + route "" Request.update + routef "/%s/cancel-snooze" Request.cancelSnooze + routef "/%s/prayed" Request.prayed + routef "/%s/show" Request.show + routef "/%s/snooze" Request.snooze + ] + POST [ + route "" Request.add + routef "/%s/note" Request.addNote + ] + ] + subRoute "/user/" [ + GET_HEAD [ + route "log-off" User.logOff + route "log-on" User.logOn + ] + ] +] diff --git a/src/MyPrayerJournal/Views/Helpers.fs b/src/MyPrayerJournal/Views/Helpers.fs index 68adc5b..aeba493 100644 --- a/src/MyPrayerJournal/Views/Helpers.fs +++ b/src/MyPrayerJournal/Views/Helpers.fs @@ -9,23 +9,23 @@ open NodaTime /// Create a link that targets the `#top` element and pushes a URL to history let pageLink href attrs = - attrs - |> List.append [ _href href; _hxBoost; _hxTarget "#top"; _hxSwap HxSwap.InnerHtml; _hxPushUrl ] - |> a + attrs + |> List.append [ _href href; _hxBoost; _hxTarget "#top"; _hxSwap HxSwap.InnerHtml; _hxPushUrl ] + |> a /// Create a Material icon let icon name = span [ _class "material-icons" ] [ str name ] /// Create a card when there are no results found let noResults heading link buttonText text = - div [ _class "card" ] [ - h5 [ _class "card-header"] [ str heading ] - div [ _class "card-body text-center" ] [ - p [ _class "card-text" ] text - pageLink link [ _class "btn btn-primary" ] [ str buttonText ] - ] + div [ _class "card" ] [ + h5 [ _class "card-header"] [ str heading ] + div [ _class "card-body text-center" ] [ + p [ _class "card-text" ] text + pageLink link [ _class "btn btn-primary" ] [ str buttonText ] + ] ] /// Create a date with a span tag, displaying the relative date with the full date/time in the tooltip let relativeDate (date : Instant) now = - span [ _title (date.ToDateTimeOffset().ToString ("f", null)) ] [ Dates.formatDistance now date |> str ] + span [ _title (date.ToDateTimeOffset().ToString ("f", null)) ] [ Dates.formatDistance now date |> str ] diff --git a/src/MyPrayerJournal/Views/Journal.fs b/src/MyPrayerJournal/Views/Journal.fs index 680f401..ec2163b 100644 --- a/src/MyPrayerJournal/Views/Journal.fs +++ b/src/MyPrayerJournal/Views/Journal.fs @@ -8,170 +8,167 @@ open MyPrayerJournal /// Display a card for this prayer request let journalCard now req = - let reqId = RequestId.toString req.requestId - let spacer = span [] [ rawText " " ] - div [ _class "col" ] [ - div [ _class "card h-100" ] [ - div [ _class "card-header p-0 d-flex"; _roleToolBar ] [ - pageLink $"/request/{reqId}/edit" [ _class "btn btn-secondary"; _title "Edit Request" ] [ icon "edit" ] - spacer - button [ - _type "button" - _class "btn btn-secondary" - _title "Add Notes" - _data "bs-toggle" "modal" - _data "bs-target" "#notesModal" - _hxGet $"/components/request/{reqId}/add-notes" - _hxTarget "#notesBody" - _hxSwap HxSwap.InnerHtml - ] [ icon "comment" ] - spacer - button [ - _type "button" - _class "btn btn-secondary" - _title "Snooze Request" - _data "bs-toggle" "modal" - _data "bs-target" "#snoozeModal" - _hxGet $"/components/request/{reqId}/snooze" - _hxTarget "#snoozeBody" - _hxSwap HxSwap.InnerHtml - ] [ icon "schedule" ] - div [ _class "flex-grow-1" ] [] - button [ - _type "button" - _class "btn btn-success w-25" - _hxPatch $"/request/{reqId}/prayed" - _title "Mark as Prayed" - ] [ icon "done" ] + let reqId = RequestId.toString req.requestId + let spacer = span [] [ rawText " " ] + div [ _class "col" ] [ + div [ _class "card h-100" ] [ + div [ _class "card-header p-0 d-flex"; _roleToolBar ] [ + pageLink $"/request/{reqId}/edit" [ _class "btn btn-secondary"; _title "Edit Request" ] [ icon "edit" ] + spacer + button [ _type "button" + _class "btn btn-secondary" + _title "Add Notes" + _data "bs-toggle" "modal" + _data "bs-target" "#notesModal" + _hxGet $"/components/request/{reqId}/add-notes" + _hxTarget "#notesBody" + _hxSwap HxSwap.InnerHtml ] [ + icon "comment" + ] + spacer + button [ _type "button" + _class "btn btn-secondary" + _title "Snooze Request" + _data "bs-toggle" "modal" + _data "bs-target" "#snoozeModal" + _hxGet $"/components/request/{reqId}/snooze" + _hxTarget "#snoozeBody" + _hxSwap HxSwap.InnerHtml ] [ + icon "schedule" + ] + div [ _class "flex-grow-1" ] [] + button [ _type "button" + _class "btn btn-success w-25" + _hxPatch $"/request/{reqId}/prayed" + _title "Mark as Prayed" ] [ + icon "done" + ] + ] + 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 now ] + ] ] - 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 now ] - ] - ] ] /// The journal loading page -let journal user = article [ _class "container-fluid mt-3" ] [ - h2 [ _class "pb-3" ] [ - str user - match user with "Your" -> () | _ -> rawText "’s" - str " Prayer Journal" - ] - p [ _class "pb-3 text-center" ] [ - pageLink "/request/new/edit" [ _class "btn btn-primary "] [ icon "add_box"; str " Add a Prayer Request" ] - ] - p [ _hxGet "/components/journal-items"; _hxSwap HxSwap.OuterHtml; _hxTrigger HxTrigger.Load ] [ - rawText "Loading your prayer journal…" - ] - div [ - _id "notesModal" - _class "modal fade" - _tabindex "-1" - _ariaLabelledBy "nodesModalLabel" - _ariaHidden "true" - ] [ - div [ _class "modal-dialog modal-dialog-scrollable" ] [ - div [ _class "modal-content" ] [ - div [ _class "modal-header" ] [ - h5 [ _class "modal-title"; _id "nodesModalLabel" ] [ str "Add Notes to Prayer Request" ] - button [ _type "button"; _class "btn-close"; _data "bs-dismiss" "modal"; _ariaLabel "Close" ] [] - ] - div [ _class "modal-body"; _id "notesBody" ] [ ] - div [ _class "modal-footer" ] [ - button [ _type "button"; _id "notesDismiss"; _class "btn btn-secondary"; _data "bs-dismiss" "modal" ] [ - str "Close" - ] - ] +let journal user = + article [ _class "container-fluid mt-3" ] [ + h2 [ _class "pb-3" ] [ + str user + match user with "Your" -> () | _ -> rawText "’s" + str " Prayer Journal" ] - ] - ] - div [ - _id "snoozeModal" - _class "modal fade" - _tabindex "-1" - _ariaLabelledBy "snoozeModalLabel" - _ariaHidden "true" - ] [ - div [ _class "modal-dialog modal-sm" ] [ - div [ _class "modal-content" ] [ - div [ _class "modal-header" ] [ - h5 [ _class "modal-title"; _id "snoozeModalLabel" ] [ str "Snooze Prayer Request" ] - button [ _type "button"; _class "btn-close"; _data "bs-dismiss" "modal"; _ariaLabel "Close" ] [] - ] - div [ _class "modal-body"; _id "snoozeBody" ] [ ] - div [ _class "modal-footer" ] [ - button [ _type "button"; _id "snoozeDismiss"; _class "btn btn-secondary"; _data "bs-dismiss" "modal" ] [ - str "Close" - ] - ] + p [ _class "pb-3 text-center" ] [ + pageLink "/request/new/edit" [ _class "btn btn-primary "] [ icon "add_box"; str " Add a Prayer Request" ] + ] + p [ _hxGet "/components/journal-items"; _hxSwap HxSwap.OuterHtml; _hxTrigger HxTrigger.Load ] [ + rawText "Loading your prayer journal…" + ] + div [ _id "notesModal" + _class "modal fade" + _tabindex "-1" + _ariaLabelledBy "nodesModalLabel" + _ariaHidden "true" ] [ + div [ _class "modal-dialog modal-dialog-scrollable" ] [ + div [ _class "modal-content" ] [ + div [ _class "modal-header" ] [ + h5 [ _class "modal-title"; _id "nodesModalLabel" ] [ str "Add Notes to Prayer Request" ] + button [ _type "button"; _class "btn-close"; _data "bs-dismiss" "modal"; _ariaLabel "Close" ] [] + ] + div [ _class "modal-body"; _id "notesBody" ] [ ] + div [ _class "modal-footer" ] [ + button [ _type "button" + _id "notesDismiss" + _class "btn btn-secondary" + _data "bs-dismiss" "modal" ] [ + str "Close" + ] + ] + ] + ] + ] + div [ _id "snoozeModal" + _class "modal fade" + _tabindex "-1" + _ariaLabelledBy "snoozeModalLabel" + _ariaHidden "true" ] [ + div [ _class "modal-dialog modal-sm" ] [ + div [ _class "modal-content" ] [ + div [ _class "modal-header" ] [ + h5 [ _class "modal-title"; _id "snoozeModalLabel" ] [ str "Snooze Prayer Request" ] + button [ _type "button"; _class "btn-close"; _data "bs-dismiss" "modal"; _ariaLabel "Close" ] [] + ] + div [ _class "modal-body"; _id "snoozeBody" ] [ ] + div [ _class "modal-footer" ] [ + button [ _type "button" + _id "snoozeDismiss" + _class "btn btn-secondary" + _data "bs-dismiss" "modal" ] [ + str "Close" + ] + ] + ] + ] ] - ] ] - ] /// The journal items let journalItems now items = - match items |> List.isEmpty with - | true -> - noResults "No Active Requests" "/request/new/edit" "Add a Request" [ - rawText "You have no requests to be shown; see the “Active” link above for snoozed or deferred " - rawText "requests, and the “Answered” link for answered requests" + match items |> List.isEmpty with + | true -> + noResults "No Active Requests" "/request/new/edit" "Add a Request" [ + rawText "You have no requests to be shown; see the “Active” link above for snoozed or deferred " + rawText "requests, and the “Answered” link for answered requests" ] - | false -> - items - |> 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" - _hxTarget "this" - _hxSwap HxSwap.OuterHtml - ] + | false -> + items + |> 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" + _hxTarget "this" + _hxSwap HxSwap.OuterHtml ] /// The notes edit modal body let notesEdit requestId = - let reqId = RequestId.toString requestId - [ form [ _hxPost $"/request/{reqId}/note" ] [ - div [ _class "form-floating pb-3" ] [ - textarea [ - _id "notes" - _name "notes" - _class "form-control" - _style "min-height: 8rem;" - _placeholder "Notes" - _autofocus; _required - ] [ ] - label [ _for "notes" ] [ str "Notes" ] + let reqId = RequestId.toString requestId + [ form [ _hxPost $"/request/{reqId}/note" ] [ + div [ _class "form-floating pb-3" ] [ + textarea [ _id "notes" + _name "notes" + _class "form-control" + _style "min-height: 8rem;" + _placeholder "Notes" + _autofocus; _required ] [ ] + label [ _for "notes" ] [ str "Notes" ] + ] + p [ _class "text-end" ] [ button [ _type "submit"; _class "btn btn-primary" ] [ str "Add Notes" ] ] ] - p [ _class "text-end" ] [ button [ _type "submit"; _class "btn btn-primary" ] [ str "Add Notes" ] ] - ] - hr [ _style "margin: .5rem -1rem" ] - div [ _id "priorNotes" ] [ - p [ _class "text-center pt-3" ] [ - button [ - _type "button" - _class "btn btn-secondary" - _hxGet $"/components/request/{reqId}/notes" - _hxSwap HxSwap.OuterHtml - _hxTarget "#priorNotes" - ] [str "Load Prior Notes" ] + hr [ _style "margin: .5rem -1rem" ] + div [ _id "priorNotes" ] [ + p [ _class "text-center pt-3" ] [ + button [ _type "button" + _class "btn btn-secondary" + _hxGet $"/components/request/{reqId}/notes" + _hxSwap HxSwap.OuterHtml + _hxTarget "#priorNotes" ] [ + str "Load Prior Notes" + ] + ] ] - ] ] /// The snooze edit form let snooze requestId = - let today = System.DateTime.Today.ToString "yyyy-MM-dd" - form [ - _hxPatch $"/request/{RequestId.toString requestId}/snooze" - _hxTarget "#journalItems" - _hxSwap HxSwap.OuterHtml - ] [ - div [ _class "form-floating pb-3" ] [ - 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" ] ] + let today = System.DateTime.Today.ToString "yyyy-MM-dd" + form [ _hxPatch $"/request/{RequestId.toString requestId}/snooze" + _hxTarget "#journalItems" + _hxSwap HxSwap.OuterHtml ] [ + div [ _class "form-floating pb-3" ] [ + 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" ] ] ] diff --git a/src/MyPrayerJournal/Views/Layout.fs b/src/MyPrayerJournal/Views/Layout.fs index 849f427..49ef3d8 100644 --- a/src/MyPrayerJournal/Views/Layout.fs +++ b/src/MyPrayerJournal/Views/Layout.fs @@ -7,141 +7,144 @@ open Giraffe.ViewEngine open Giraffe.ViewEngine.Accessibility /// The data needed to render a page-level view -type PageRenderContext = { - /// Whether the user is authenticated - isAuthenticated : bool - /// Whether the user has snoozed requests - hasSnoozed : bool - /// The current URL - currentUrl : string - /// The title for the page to be rendered - pageTitle : string - /// The content of the page - content : XmlNode - } +type PageRenderContext = + { /// Whether the user is authenticated + isAuthenticated : bool + + /// Whether the user has snoozed requests + hasSnoozed : bool + + /// The current URL + currentUrl : string + + /// The title for the page to be rendered + pageTitle : string + + /// The content of the page + content : XmlNode + } /// The home page -let home = article [ _class "container mt-3" ] [ - p [] [ rawText " " ] - p [] [ - str "myPrayerJournal is a place where individuals can record their prayer requests, record that they prayed for " - str "them, update them as God moves in the situation, and record a final answer received on that request. It also " - str "allows individuals to review their answered prayers." +let home = + article [ _class "container mt-3" ] [ + p [] [ rawText " " ] + p [] [ + str "myPrayerJournal is a place where individuals can record their prayer requests, record that they " + str "prayed for them, update them as God moves in the situation, and record a final answer received on " + str "that request. It also allows individuals to review their answered prayers." + ] + p [] [ + str "This site is open and available to the general public. To get started, simply click the " + rawText "“Log On” link above, and log on with either a Microsoft or Google account. You can " + rawText "also learn more about the site at the “Docs” link, also above." + ] ] - p [] [ - str "This site is open and available to the general public. To get started, simply click the " - rawText "“Log On” link above, and log on with either a Microsoft or Google account. You can also " - rawText "learn more about the site at the “Docs” link, also above." - ] - ] /// The default navigation bar, which will load the items on page load, and whenever a refresh event occurs let private navBar ctx = - nav [ _class "navbar navbar-dark"; _roleNavigation ] [ - div [ _class "container-fluid" ] [ - pageLink "/" [ _class "navbar-brand" ] [ - span [ _class "m" ] [ str "my" ] - span [ _class "p" ] [ str "Prayer" ] - span [ _class "j" ] [ str "Journal" ] - ] - seq { - let navLink (matchUrl : string) = - match ctx.currentUrl.StartsWith matchUrl with true -> [ _class "is-active-route" ] | false -> [] - |> pageLink matchUrl - match ctx.isAuthenticated with - | true -> - li [ _class "nav-item" ] [ navLink "/journal" [ str "Journal" ] ] - li [ _class "nav-item" ] [ navLink "/requests/active" [ str "Active" ] ] - if ctx.hasSnoozed then li [ _class "nav-item" ] [ navLink "/requests/snoozed" [ str "Snoozed" ] ] - li [ _class "nav-item" ] [ navLink "/requests/answered" [ str "Answered" ] ] - li [ _class "nav-item" ] [ a [ _href "/user/log-off" ] [ str "Log Off" ] ] - | false -> li [ _class "nav-item"] [ a [ _href "/user/log-on" ] [ str "Log On" ] ] - li [ _class "nav-item" ] [ - a [ _href "https://docs.prayerjournal.me"; _target "_blank"; _rel "noopener" ] [ str "Docs" ] - ] - } - |> List.ofSeq - |> ul [ _class "navbar-nav me-auto d-flex flex-row" ] - ] + nav [ _class "navbar navbar-dark"; _roleNavigation ] [ + div [ _class "container-fluid" ] [ + pageLink "/" [ _class "navbar-brand" ] [ + span [ _class "m" ] [ str "my" ] + span [ _class "p" ] [ str "Prayer" ] + span [ _class "j" ] [ str "Journal" ] + ] + seq { + let navLink (matchUrl : string) = + match ctx.currentUrl.StartsWith matchUrl with true -> [ _class "is-active-route" ] | false -> [] + |> pageLink matchUrl + if ctx.isAuthenticated then + li [ _class "nav-item" ] [ navLink "/journal" [ str "Journal" ] ] + li [ _class "nav-item" ] [ navLink "/requests/active" [ str "Active" ] ] + if ctx.hasSnoozed then li [ _class "nav-item" ] [ navLink "/requests/snoozed" [ str "Snoozed" ] ] + li [ _class "nav-item" ] [ navLink "/requests/answered" [ str "Answered" ] ] + li [ _class "nav-item" ] [ a [ _href "/user/log-off" ] [ str "Log Off" ] ] + else li [ _class "nav-item"] [ a [ _href "/user/log-on" ] [ str "Log On" ] ] + li [ _class "nav-item" ] [ + a [ _href "https://docs.prayerjournal.me"; _target "_blank"; _rel "noopener" ] [ str "Docs" ] + ] + } + |> List.ofSeq + |> ul [ _class "navbar-nav me-auto d-flex flex-row" ] + ] ] /// The title tag with the application name appended -let titleTag ctx = title [] [ str ctx.pageTitle; rawText " « myPrayerJournal" ] +let titleTag ctx = + title [] [ str ctx.pageTitle; rawText " « myPrayerJournal" ] /// The HTML `head` element let htmlHead ctx = - head [ _lang "en" ] [ - meta [ _name "viewport"; _content "width=device-width, initial-scale=1" ] - meta [ _name "description"; _content "Online prayer journal - free w/Google or Microsoft account" ] - titleTag ctx - link [ - _href "https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/css/bootstrap.min.css" - _rel "stylesheet" - _integrity "sha384-EVSTQN3/azprG1Anm3QDgpJLIm9Nao0Yz1ztcQTwFspd3yD65VohhpuuCOmLASjC" - _crossorigin "anonymous" - ] - link [ _href "https://fonts.googleapis.com/icon?family=Material+Icons"; _rel "stylesheet" ] - link [ _href "/style/style.css"; _rel "stylesheet" ] + head [ _lang "en" ] [ + meta [ _name "viewport"; _content "width=device-width, initial-scale=1" ] + meta [ _name "description"; _content "Online prayer journal - free w/Google or Microsoft account" ] + titleTag ctx + link [ _href "https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/css/bootstrap.min.css" + _rel "stylesheet" + _integrity "sha384-EVSTQN3/azprG1Anm3QDgpJLIm9Nao0Yz1ztcQTwFspd3yD65VohhpuuCOmLASjC" + _crossorigin "anonymous" ] + link [ _href "https://fonts.googleapis.com/icon?family=Material+Icons"; _rel "stylesheet" ] + link [ _href "/style/style.css"; _rel "stylesheet" ] ] /// Element used to display toasts let toaster = - div [ _ariaLive "polite"; _ariaAtomic "true"; _id "toastHost" ] [ - div [ _class "toast-container position-absolute p-3 bottom-0 end-0"; _id "toasts" ] [] - ] + div [ _ariaLive "polite"; _ariaAtomic "true"; _id "toastHost" ] [ + div [ _class "toast-container position-absolute p-3 bottom-0 end-0"; _id "toasts" ] [] + ] /// The page's `footer` element let htmlFoot = - footer [ _class "container-fluid" ] [ - p [ _class "text-muted text-end" ] [ - str "myPrayerJournal v3" - br [] - em [] [ - small [] [ - pageLink "/legal/privacy-policy" [] [ str "Privacy Policy" ] - rawText " • " - pageLink "/legal/terms-of-service" [] [ str "Terms of Service" ] - rawText " • " - a [ _href "https://github.com/bit-badger/myprayerjournal"; _target "_blank"; _rel "noopener" ] [ - str "Developed" + footer [ _class "container-fluid" ] [ + p [ _class "text-muted text-end" ] [ + str "myPrayerJournal v3" + br [] + em [] [ + small [] [ + pageLink "/legal/privacy-policy" [] [ str "Privacy Policy" ] + rawText " • " + pageLink "/legal/terms-of-service" [] [ str "Terms of Service" ] + rawText " • " + a [ _href "https://github.com/bit-badger/myprayerjournal"; _target "_blank"; _rel "noopener" ] [ + str "Developed" + ] + str " and hosted by " + a [ _href "https://bitbadger.solutions"; _target "_blank"; _rel "noopener" ] [ + str "Bit Badger Solutions" + ] + ] ] - str " and hosted by " - a [ _href "https://bitbadger.solutions"; _target "_blank"; _rel "noopener" ] [ str "Bit Badger Solutions" ] - ] ] - ] - Htmx.Script.minified - script [] [ - rawText "if (!htmx) document.write('