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

Version 3.1 #71

Merged
danieljsummers merged 9 commits from v3.1 into main 2022-07-30 21:02:58 +00:00
Conversation 0 Commits 9 Files Changed 19 +1519 -1490
10 changed files with 1519 additions and 1490 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files
Showing only changes of commit 0d86bad7c5 - Show all commits

115
src/MyPrayerJournal.ConvertRecurrence/Program.fs
View File

@ -3,26 +3,56 @@ open NodaTime
/// Request is the identifying record for a prayer request /// Request is the identifying record for a prayer request
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type OldRequest = { type OldRequest =
/// The ID of the request { /// The ID of the request
id : RequestId id : RequestId
/// The time this request was initially entered
enteredOn : Instant /// The time this request was initially entered
/// The ID of the user to whom this request belongs ("sub" from the JWT) enteredOn : Instant
userId : UserId
/// The time at which this request should reappear in the user's journal by manual user choice /// The ID of the user to whom this request belongs ("sub" from the JWT)
snoozedUntil : Instant userId : UserId
/// The time at which this request should reappear in the user's journal by recurrence
showAfter : Instant /// The time at which this request should reappear in the user's journal by manual user choice
/// The type of recurrence for this request snoozedUntil : Instant
recurType : string
/// How many of the recurrence intervals should occur between appearances in the journal /// The time at which this request should reappear in the user's journal by recurrence
recurCount : int16 showAfter : Instant
/// The history entries for this request
history : History array /// The type of recurrence for this request
/// The notes for this request recurType : string
notes : Note array
} /// 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
[<CLIMutable; NoComparison; NoEquality>]
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
[<CLIMutable; NoComparison; NoEquality>]
type OldNote =
{ /// The time when this note was made
asOf : Instant
/// The text of the notes
notes : string
}
open LiteDB open LiteDB
open MyPrayerJournal.Data open MyPrayerJournal.Data
@ -32,36 +62,33 @@ Startup.ensureDb db
/// Map the old recurrence to the new style /// Map the old recurrence to the new style
let mapRecurrence old = let mapRecurrence old =
match old.recurType with match old.recurType with
| "Days" -> Days old.recurCount | "Days" -> Days old.recurCount
| "Hours" -> Hours old.recurCount | "Hours" -> Hours old.recurCount
| "Weeks" -> Weeks old.recurCount | "Weeks" -> Weeks old.recurCount
| _ -> Immediate | _ -> Immediate
/// Map the old request to the new request /// Map the old request to the new request
let convert old = { let convert old =
id = old.id { id = old.id
enteredOn = old.enteredOn enteredOn = old.enteredOn
userId = old.userId userId = old.userId
snoozedUntil = old.snoozedUntil snoozedUntil = old.snoozedUntil
showAfter = old.showAfter showAfter = old.showAfter
recurrence = mapRecurrence old recurrence = mapRecurrence old
history = Array.toList old.history history = Array.toList old.history
notes = Array.toList old.notes notes = Array.toList old.notes
} }
/// Remove the old request, add the converted one (removes recurType / recurCount fields) /// Remove the old request, add the converted one (removes recurType / recurCount fields)
let replace (req : Request) = let replace (req : Request) =
db.requests.Delete(Mapping.RequestId.toBson req.id) |> ignore db.requests.Delete(Mapping.RequestId.toBson req.id) |> ignore
db.requests.Insert(req) |> ignore db.requests.Insert(req) |> ignore
db.Checkpoint() db.Checkpoint()
let reqs = db.GetCollection<OldRequest>("request").FindAll() db.GetCollection<OldRequest>("request").FindAll()
let rList = reqs |> Seq.toList |> Seq.map convert
let mapped = rList |> List.map convert |> Seq.iter replace
//let reqList = mapped |> List.ofSeq
mapped |> List.iter replace
// For more information see https://aka.ms/fsharp-console-apps // For more information see https://aka.ms/fsharp-console-apps
printfn "Done" printfn "Done"

216
src/MyPrayerJournal/Data.fs
View File

@ -11,15 +11,17 @@ open System.Threading.Tasks
[<AutoOpen>] [<AutoOpen>]
module Extensions = module Extensions =
/// Extensions on the LiteDatabase class /// Extensions on the LiteDatabase class
type LiteDatabase with type LiteDatabase with
/// The Request collection
member this.requests /// The Request collection
with get () = this.GetCollection<Request> "request" member this.requests
/// Async version of the checkpoint command (flushes log) with get () = this.GetCollection<Request> "request"
member this.saveChanges () =
this.Checkpoint () /// Async version of the checkpoint command (flushes log)
Task.CompletedTask member this.saveChanges () =
this.Checkpoint ()
Task.CompletedTask
/// Map domain to LiteDB /// Map domain to LiteDB
@ -27,162 +29,162 @@ module Extensions =
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Mapping = module Mapping =
/// Mapping for NodaTime's Instant type /// Mapping for NodaTime's Instant type
module Instant = module Instant =
let fromBson (value : BsonValue) = Instant.FromUnixTimeMilliseconds value.AsInt64 let fromBson (value : BsonValue) = Instant.FromUnixTimeMilliseconds value.AsInt64
let toBson (value : Instant) : BsonValue = value.ToUnixTimeMilliseconds () let toBson (value : Instant) : BsonValue = value.ToUnixTimeMilliseconds ()
/// Mapping for option types /// Mapping for option types
module Option = module Option =
let stringFromBson (value : BsonValue) = match value.AsString with "" -> None | x -> Some x 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 -> "" let stringToBson (value : string option) : BsonValue = match value with Some txt -> txt | None -> ""
/// Mapping for Recurrence /// Mapping for Recurrence
module Recurrence = module Recurrence =
let fromBson (value : BsonValue) = Recurrence.ofString value let fromBson (value : BsonValue) = Recurrence.ofString value
let toBson (value : Recurrence) : BsonValue = Recurrence.toString value let toBson (value : Recurrence) : BsonValue = Recurrence.toString value
/// Mapping for RequestAction /// Mapping for RequestAction
module RequestAction = module RequestAction =
let fromBson (value : BsonValue) = RequestAction.ofString value.AsString let fromBson (value : BsonValue) = RequestAction.ofString value.AsString
let toBson (value : RequestAction) : BsonValue = RequestAction.toString value let toBson (value : RequestAction) : BsonValue = RequestAction.toString value
/// Mapping for RequestId /// Mapping for RequestId
module RequestId = module RequestId =
let fromBson (value : BsonValue) = RequestId.ofString value.AsString let fromBson (value : BsonValue) = RequestId.ofString value.AsString
let toBson (value : RequestId) : BsonValue = RequestId.toString value let toBson (value : RequestId) : BsonValue = RequestId.toString value
/// Mapping for UserId /// Mapping for UserId
module UserId = module UserId =
let fromBson (value : BsonValue) = UserId value.AsString let fromBson (value : BsonValue) = UserId value.AsString
let toBson (value : UserId) : BsonValue = UserId.toString value let toBson (value : UserId) : BsonValue = UserId.toString value
/// Set up the mapping /// Set up the mapping
let register () = let register () =
BsonMapper.Global.RegisterType<Instant>(Instant.toBson, Instant.fromBson) BsonMapper.Global.RegisterType<Instant>(Instant.toBson, Instant.fromBson)
BsonMapper.Global.RegisterType<Recurrence>(Recurrence.toBson, Recurrence.fromBson) BsonMapper.Global.RegisterType<Recurrence>(Recurrence.toBson, Recurrence.fromBson)
BsonMapper.Global.RegisterType<RequestAction>(RequestAction.toBson, RequestAction.fromBson) BsonMapper.Global.RegisterType<RequestAction>(RequestAction.toBson, RequestAction.fromBson)
BsonMapper.Global.RegisterType<RequestId>(RequestId.toBson, RequestId.fromBson) BsonMapper.Global.RegisterType<RequestId>(RequestId.toBson, RequestId.fromBson)
BsonMapper.Global.RegisterType<string option>(Option.stringToBson, Option.stringFromBson) BsonMapper.Global.RegisterType<string option>(Option.stringToBson, Option.stringFromBson)
BsonMapper.Global.RegisterType<UserId>(UserId.toBson, UserId.fromBson) BsonMapper.Global.RegisterType<UserId>(UserId.toBson, UserId.fromBson)
/// Code to be run at startup /// Code to be run at startup
module Startup = module Startup =
/// Ensure the database is set up /// Ensure the database is set up
let ensureDb (db : LiteDatabase) = let ensureDb (db : LiteDatabase) =
db.requests.EnsureIndex (fun it -> it.userId) |> ignore db.requests.EnsureIndex (fun it -> it.userId) |> ignore
Mapping.register () Mapping.register ()
/// Async wrappers for LiteDB, and request -> journal mappings /// Async wrappers for LiteDB, and request -> journal mappings
[<AutoOpen>] [<AutoOpen>]
module private Helpers = module private Helpers =
open System.Linq open System.Linq
/// Convert a sequence to a list asynchronously (used for LiteDB IO) /// Convert a sequence to a list asynchronously (used for LiteDB IO)
let toListAsync<'T> (q : 'T seq) = let toListAsync<'T> (q : 'T seq) =
(q.ToList >> Task.FromResult) () (q.ToList >> Task.FromResult) ()
/// Convert a sequence to a list asynchronously (used for LiteDB IO) /// Convert a sequence to a list asynchronously (used for LiteDB IO)
let firstAsync<'T> (q : 'T seq) = let firstAsync<'T> (q : 'T seq) =
q.FirstOrDefault () |> Task.FromResult q.FirstOrDefault () |> Task.FromResult
/// Async wrapper around a request update /// Async wrapper around a request update
let doUpdate (db : LiteDatabase) (req : Request) = let doUpdate (db : LiteDatabase) (req : Request) =
db.requests.Update req |> ignore db.requests.Update req |> ignore
Task.CompletedTask Task.CompletedTask
/// 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) = backgroundTask { let tryFullRequestById reqId userId (db : LiteDatabase) = backgroundTask {
let! req = db.requests.Find (Query.EQ ("_id", RequestId.toString reqId)) |> 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
} }
/// Add a history entry /// Add a history entry
let addHistory reqId userId hist db = backgroundTask { let addHistory reqId userId hist db = backgroundTask {
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 = backgroundTask { let addNote reqId userId note db = backgroundTask {
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
let addRequest (req : Request) (db : LiteDatabase) = let addRequest (req : Request) (db : LiteDatabase) =
db.requests.Insert req |> ignore db.requests.Insert req |> ignore
// FIXME: make a common function here // FIXME: make a common function here
/// Retrieve all answered requests for the given user /// Retrieve all answered requests for the given user
let answeredRequests userId (db : LiteDatabase) = backgroundTask { let answeredRequests userId (db : LiteDatabase) = backgroundTask {
let! reqs = db.requests.Find (Query.EQ ("userId", UserId.toString userId)) |> 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
|> Seq.filter (fun it -> it.lastStatus = Answered) |> Seq.filter (fun it -> it.lastStatus = Answered)
|> Seq.sortByDescending (fun it -> it.asOf) |> Seq.sortByDescending (fun it -> it.asOf)
|> List.ofSeq |> List.ofSeq
} }
/// Retrieve the user's current journal /// Retrieve the user's current journal
let journalByUserId userId (db : LiteDatabase) = backgroundTask { let journalByUserId userId (db : LiteDatabase) = backgroundTask {
let! jrnl = db.requests.Find (Query.EQ ("userId", UserId.toString userId)) |> 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
|> Seq.filter (fun it -> it.lastStatus <> Answered) |> Seq.filter (fun it -> it.lastStatus <> Answered)
|> Seq.sortBy (fun it -> it.asOf) |> Seq.sortBy (fun it -> it.asOf)
|> List.ofSeq |> List.ofSeq
} }
/// Does the user have any snoozed requests? /// Does the user have any snoozed requests?
let hasSnoozed userId now (db : LiteDatabase) = backgroundTask { let hasSnoozed userId now (db : LiteDatabase) = backgroundTask {
let! jrnl = journalByUserId userId db let! jrnl = journalByUserId userId db
return jrnl |> List.exists (fun r -> r.snoozedUntil > now) return jrnl |> List.exists (fun r -> r.snoozedUntil > now)
} }
/// 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 = backgroundTask { let tryRequestById reqId userId db = backgroundTask {
let! req = tryFullRequestById reqId userId db let! req = tryFullRequestById reqId userId db
return req |> Option.map (fun r -> { r with history = []; notes = [] }) return req |> Option.map (fun r -> { r with history = []; notes = [] })
} }
/// Retrieve notes for a request by its ID and user ID /// Retrieve notes for a request by its ID and user ID
let notesById reqId userId (db : LiteDatabase) = backgroundTask { 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 /// Retrieve a journal request by its ID and user ID
let tryJournalById reqId userId (db : LiteDatabase) = backgroundTask { let tryJournalById reqId userId (db : LiteDatabase) = backgroundTask {
let! req = tryFullRequestById reqId userId db let! req = tryFullRequestById reqId userId db
return req |> Option.map JournalRequest.ofRequestLite return req |> Option.map JournalRequest.ofRequestLite
} }
/// Update the recurrence for a request /// Update the recurrence for a request
let updateRecurrence reqId userId recurType db = backgroundTask { let updateRecurrence reqId userId recurType db = backgroundTask {
match! tryFullRequestById reqId userId db with match! tryFullRequestById reqId userId db with
| Some req -> do! doUpdate db { req with recurrence = recurType } | Some req -> do! doUpdate db { req with recurrence = recurType }
| 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 = backgroundTask { let updateSnoozed reqId userId until db = backgroundTask {
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 = backgroundTask { let updateShowAfter reqId userId showAfter db = backgroundTask {
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"
} }

106
src/MyPrayerJournal/Dates.fs
View File

@ -5,39 +5,39 @@ module MyPrayerJournal.Dates
open NodaTime open NodaTime
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>
Map.ofList [ Map.ofList [
"en-US", Map.ofList [ "en-US", Map.ofList [
LessThanXMinutes, ("less than a minute", format "less than %i minutes") LessThanXMinutes, ("less than a minute", format "less than %i minutes")
XMinutes, ("a minute", format "%i minutes") XMinutes, ("a minute", format "%i minutes")
AboutXHours, ("about an hour", format "about %i hours") AboutXHours, ("about an hour", format "about %i hours")
XHours, ("an hour", format "%i hours") XHours, ("an hour", format "%i hours")
XDays, ("a day", format "%i days") XDays, ("a day", format "%i days")
AboutXWeeks, ("about a week", format "about %i weeks") AboutXWeeks, ("about a week", format "about %i weeks")
XWeeks, ("a week", format "%i weeks") XWeeks, ("a week", format "%i weeks")
AboutXMonths, ("about a month", format "about %i months") AboutXMonths, ("about a month", format "about %i months")
XMonths, ("a month", format "%i months") XMonths, ("a month", format "%i months")
AboutXYears, ("about a year", format "about %i years") AboutXYears, ("about a year", format "about %i years")
XYears, ("a year", format "%i years") XYears, ("a year", format "%i years")
OverXYears, ("over a year", format "over %i years") OverXYears, ("over a year", format "over %i years")
AlmostXYears, ("almost a year", format "almost %i years") AlmostXYears, ("almost a year", format "almost %i years")
]
] ]
]
let aDay = 1_440. let aDay = 1_440.
let almost2Days = 2_520. let almost2Days = 2_520.
@ -50,29 +50,29 @@ open System
let fromJs ticks = DateTime.UnixEpoch + TimeSpan.FromTicks (ticks * 10_000L) let fromJs ticks = DateTime.UnixEpoch + TimeSpan.FromTicks (ticks * 10_000L)
let formatDistance (startDate : Instant) (endDate : Instant) = let formatDistance (startDate : Instant) (endDate : Instant) =
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
let minutes = Math.Abs diff.TotalMinutes let minutes = Math.Abs diff.TotalMinutes
let formatToken = let formatToken =
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 < almost2Days -> 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
format formatToken "en-US" format formatToken "en-US"
|> match startDate > endDate with true -> sprintf "%s ago" | false -> sprintf "in %s" |> match startDate > endDate with true -> sprintf "%s ago" | false -> sprintf "in %s"

357
src/MyPrayerJournal/Domain.fs
View File

@ -9,205 +9,244 @@ open Cuid
open NodaTime open NodaTime
/// An identifier for a request /// An identifier for a request
type RequestId = type RequestId = RequestId of Cuid
| RequestId of Cuid
/// Functions to manipulate request IDs /// Functions to manipulate request IDs
module RequestId = module RequestId =
/// The string representation of the request ID
let toString = function RequestId x -> Cuid.toString x /// The string representation of the request ID
/// Create a request ID from a string representation let toString = function RequestId x -> Cuid.toString x
let ofString = Cuid >> RequestId
/// Create a request ID from a string representation
let ofString = Cuid >> RequestId
/// The identifier of a user (the "sub" part of the JWT) /// The identifier of a user (the "sub" part of the JWT)
type UserId = type UserId = UserId of string
| UserId of string
/// Functions to manipulate user IDs /// Functions to manipulate user IDs
module UserId = 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" /// How frequently a request should reappear after it is marked "Prayed"
type Recurrence = type Recurrence =
| Immediate /// A request should reappear immediately at the bottom of the list
| Hours of int16 | Immediate
| Days of int16 /// A request should reappear in the given number of hours
| Weeks of int16 | 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 /// Functions to manipulate recurrences
module Recurrence = module Recurrence =
/// Create a string representation of a recurrence
let toString = /// Create a string representation of a recurrence
function let toString =
| Immediate -> "Immediate" function
| Hours h -> $"{h} Hours" | Immediate -> "Immediate"
| Days d -> $"{d} Days" | Hours h -> $"{h} Hours"
| Weeks w -> $"{w} Weeks" | Days d -> $"{d} Days"
/// Create a recurrence value from a string | Weeks w -> $"{w} Weeks"
let ofString =
function /// Create a recurrence value from a string
| "Immediate" -> Immediate let ofString =
| it when it.Contains " " -> function
let parts = it.Split " " | "Immediate" -> Immediate
let length = Convert.ToInt16 parts[0] | it when it.Contains " " ->
match parts[1] with let parts = it.Split " "
| "Hours" -> Hours length let length = Convert.ToInt16 parts[0]
| "Days" -> Days length match parts[1] with
| "Weeks" -> Weeks length | "Hours" -> Hours length
| _ -> invalidOp $"{parts[1]} is not a valid recurrence" | "Days" -> Days length
| it -> invalidOp $"{it} is not a valid recurrence" | "Weeks" -> Weeks length
/// An hour's worth of seconds | _ -> invalidOp $"{parts[1]} is not a valid recurrence"
let private oneHour = 3_600L | it -> invalidOp $"{it} is not a valid recurrence"
/// The duration of the recurrence (in milliseconds)
let duration = /// An hour's worth of seconds
function let private oneHour = 3_600L
| Immediate -> 0L
| Hours h -> int64 h * oneHour /// The duration of the recurrence (in milliseconds)
| Days d -> int64 d * oneHour * 24L let duration =
| Weeks w -> int64 w * oneHour * 24L * 7L 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 /// The action taken on a request as part of a history entry
type RequestAction = type RequestAction =
| Created | Created
| Prayed | Prayed
| Updated | Updated
| Answered | Answered
/// History is a record of action taken on a prayer request, including updates to its text /// History is a record of action taken on a prayer request, including updates to its text
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type History = { type History =
/// The time when this history entry was made { /// The time when this history entry was made
asOf : Instant asOf : Instant
/// The status for this history entry
status : RequestAction /// The status for this history entry
/// The text of the update, if applicable status : RequestAction
text : string option
} /// 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 /// Note is a note regarding a prayer request that does not result in an update to its text
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Note = { type Note =
/// The time when this note was made { /// The time when this note was made
asOf : Instant asOf : Instant
/// The text of the notes
notes : string /// The text of the notes
} notes : string
}
/// Request is the identifying record for a prayer request /// Request is the identifying record for a prayer request
[<CLIMutable; NoComparison; NoEquality>] [<CLIMutable; NoComparison; NoEquality>]
type Request = { type Request =
/// The ID of the request { /// The ID of the request
id : RequestId id : RequestId
/// The time this request was initially entered
enteredOn : Instant /// The time this request was initially entered
/// The ID of the user to whom this request belongs ("sub" from the JWT) enteredOn : Instant
userId : UserId
/// The time at which this request should reappear in the user's journal by manual user choice /// The ID of the user to whom this request belongs ("sub" from the JWT)
snoozedUntil : Instant userId : UserId
/// The time at which this request should reappear in the user's journal by recurrence
showAfter : Instant /// The time at which this request should reappear in the user's journal by manual user choice
/// The recurrence for this request snoozedUntil : Instant
recurrence : Recurrence
/// The history entries for this request /// The time at which this request should reappear in the user's journal by recurrence
history : History list showAfter : Instant
/// The notes for this request
notes : Note list /// The recurrence for this request
} recurrence : Recurrence
with
/// An empty request /// The history entries for this request
static member empty = history : History list
{ id = Cuid.generate () |> RequestId
enteredOn = Instant.MinValue /// The notes for this request
userId = UserId "" notes : Note list
snoozedUntil = Instant.MinValue }
showAfter = Instant.MinValue
recurrence = Immediate /// Functions to support requests
history = [] module Request =
notes = []
} /// 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 /// 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. /// properties that may be filled for history and notes.
[<NoComparison; NoEquality>] [<NoComparison; NoEquality>]
type JournalRequest = { type JournalRequest =
/// The ID of the request (just the CUID part) { /// The ID of the request (just the CUID part)
requestId : RequestId requestId : RequestId
/// The ID of the user to whom the request belongs
userId : UserId /// The ID of the user to whom the request belongs
/// The current text of the request userId : UserId
text : string
/// The last time action was taken on the request /// The current text of the request
asOf : Instant text : string
/// The last status for the request
lastStatus : RequestAction /// The last time action was taken on the request
/// The time that this request should reappear in the user's journal asOf : Instant
snoozedUntil : Instant
/// The time after which this request should reappear in the user's journal by configured recurrence /// The last status for the request
showAfter : Instant lastStatus : RequestAction
/// The recurrence for this request
recurrence : Recurrence /// The time that this request should reappear in the user's journal
/// History entries for the request snoozedUntil : Instant
history : History list
/// Note entries for the request /// The time after which this request should reappear in the user's journal by configured recurrence
notes : Note list 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 /// Functions to manipulate journal requests
module JournalRequest = module JournalRequest =
/// Convert a request to the form used for the journal (precomputed values, no notes or history) /// Convert a request to the form used for the journal (precomputed values, no notes or history)
let ofRequestLite (req : Request) = let ofRequestLite (req : Request) =
let hist = req.history |> List.sortByDescending (fun it -> it.asOf) |> List.tryHead let hist = req.history |> List.sortByDescending (fun it -> it.asOf) |> List.tryHead
{ requestId = req.id { requestId = req.id
userId = req.userId userId = req.userId
text = req.history text = req.history
|> List.filter (fun it -> Option.isSome it.text) |> List.filter (fun it -> Option.isSome it.text)
|> List.sortByDescending (fun it -> it.asOf) |> List.sortByDescending (fun it -> it.asOf)
|> 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 -> Instant.MinValue asOf = match hist with Some h -> h.asOf | None -> Instant.MinValue
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
recurrence = req.recurrence recurrence = req.recurrence
history = [] history = []
notes = [] notes = []
} }
/// Same as `ofRequestLite`, but with notes and history /// Same as `ofRequestLite`, but with notes and history
let ofRequestFull req = let ofRequestFull req =
{ ofRequestLite req with { ofRequestLite req with
history = req.history history = req.history
notes = req.notes notes = req.notes
} }
/// Functions to manipulate request actions /// Functions to manipulate request actions
module RequestAction = module RequestAction =
/// Create a string representation of an action
let toString = /// Create a string representation of an action
function let toString =
| Created -> "Created" function
| Prayed -> "Prayed" | Created -> "Created"
| Updated -> "Updated" | Prayed -> "Prayed"
| Answered -> "Answered" | Updated -> "Updated"
/// Create a RequestAction from a string | Answered -> "Answered"
let ofString =
function /// Create a RequestAction from a string
| "Created" -> Created let ofString =
| "Prayed" -> Prayed function
| "Updated" -> Updated | "Created" -> Created
| "Answered" -> Answered | "Prayed" -> Prayed
| it -> invalidOp $"Bad request action {it}" | "Updated" -> Updated
/// Determine if a history's status is `Created` | "Answered" -> Answered
let isCreated hist = hist.status = Created | it -> invalidOp $"Bad request action {it}"
/// Determine if a history's status is `Prayed`
let isPrayed hist = hist.status = Prayed /// Determine if a history's status is `Created`
/// Determine if a history's status is `Answered` let isCreated hist = hist.status = Created
let isAnswered hist = hist.status = Answered
/// 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

914
src/MyPrayerJournal/Handlers.fs
View File

File diff suppressed because it is too large Load Diff

20
src/MyPrayerJournal/Views/Helpers.fs
View File

@ -9,23 +9,23 @@ open NodaTime
/// Create a link that targets the `#top` element and pushes a URL to history /// Create a link that targets the `#top` element and pushes a URL to history
let pageLink href attrs = let pageLink href attrs =
attrs attrs
|> List.append [ _href href; _hxBoost; _hxTarget "#top"; _hxSwap HxSwap.InnerHtml; _hxPushUrl ] |> List.append [ _href href; _hxBoost; _hxTarget "#top"; _hxSwap HxSwap.InnerHtml; _hxPushUrl ]
|> a |> a
/// Create a Material icon /// Create a Material icon
let icon name = span [ _class "material-icons" ] [ str name ] let icon name = span [ _class "material-icons" ] [ str name ]
/// Create a card when there are no results found /// Create a card when there are no results found
let noResults heading link buttonText text = let noResults heading link buttonText text =
div [ _class "card" ] [ div [ _class "card" ] [
h5 [ _class "card-header"] [ str heading ] h5 [ _class "card-header"] [ str heading ]
div [ _class "card-body text-center" ] [ div [ _class "card-body text-center" ] [
p [ _class "card-text" ] text p [ _class "card-text" ] text
pageLink link [ _class "btn btn-primary" ] [ str buttonText ] 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 /// Create a date with a span tag, displaying the relative date with the full date/time in the tooltip
let relativeDate (date : Instant) now = 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 ]

289
src/MyPrayerJournal/Views/Journal.fs
View File

@ -8,170 +8,167 @@ open MyPrayerJournal
/// Display a card for this prayer request /// Display a card for this prayer request
let journalCard now req = let journalCard now req =
let reqId = RequestId.toString req.requestId let reqId = RequestId.toString req.requestId
let spacer = span [] [ rawText "&nbsp;" ] let spacer = span [] [ rawText "&nbsp;" ]
div [ _class "col" ] [ div [ _class "col" ] [
div [ _class "card h-100" ] [ div [ _class "card h-100" ] [
div [ _class "card-header p-0 d-flex"; _roleToolBar ] [ div [ _class "card-header p-0 d-flex"; _roleToolBar ] [
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" _hxGet $"/components/request/{reqId}/add-notes"
_hxGet $"/components/request/{reqId}/add-notes" _hxTarget "#notesBody"
_hxTarget "#notesBody" _hxSwap HxSwap.InnerHtml ] [
_hxSwap HxSwap.InnerHtml icon "comment"
] [ icon "comment" ] ]
spacer spacer
button [ button [ _type "button"
_type "button" _class "btn btn-secondary"
_class "btn btn-secondary" _title "Snooze Request"
_title "Snooze Request" _data "bs-toggle" "modal"
_data "bs-toggle" "modal" _data "bs-target" "#snoozeModal"
_data "bs-target" "#snoozeModal" _hxGet $"/components/request/{reqId}/snooze"
_hxGet $"/components/request/{reqId}/snooze" _hxTarget "#snoozeBody"
_hxTarget "#snoozeBody" _hxSwap HxSwap.InnerHtml ] [
_hxSwap HxSwap.InnerHtml icon "schedule"
] [ icon "schedule" ] ]
div [ _class "flex-grow-1" ] [] div [ _class "flex-grow-1" ] []
button [ button [ _type "button"
_type "button" _class "btn btn-success w-25"
_class "btn btn-success w-25" _hxPatch $"/request/{reqId}/prayed"
_hxPatch $"/request/{reqId}/prayed" _title "Mark as Prayed" ] [
_title "Mark as Prayed" icon "done"
] [ 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 /// The journal loading page
let journal user = article [ _class "container-fluid mt-3" ] [ let journal user =
h2 [ _class "pb-3" ] [ article [ _class "container-fluid mt-3" ] [
str user h2 [ _class "pb-3" ] [
match user with "Your" -> () | _ -> rawText "&rsquo;s" str user
str " Prayer Journal" match user with "Your" -> () | _ -> rawText "&rsquo;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&hellip;"
]
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"
]
]
] ]
] p [ _class "pb-3 text-center" ] [
] pageLink "/request/new/edit" [ _class "btn btn-primary "] [ icon "add_box"; str " Add a Prayer Request" ]
div [ ]
_id "snoozeModal" p [ _hxGet "/components/journal-items"; _hxSwap HxSwap.OuterHtml; _hxTrigger HxTrigger.Load ] [
_class "modal fade" rawText "Loading your prayer journal&hellip;"
_tabindex "-1" ]
_ariaLabelledBy "snoozeModalLabel" div [ _id "notesModal"
_ariaHidden "true" _class "modal fade"
] [ _tabindex "-1"
div [ _class "modal-dialog modal-sm" ] [ _ariaLabelledBy "nodesModalLabel"
div [ _class "modal-content" ] [ _ariaHidden "true" ] [
div [ _class "modal-header" ] [ div [ _class "modal-dialog modal-dialog-scrollable" ] [
h5 [ _class "modal-title"; _id "snoozeModalLabel" ] [ str "Snooze Prayer Request" ] div [ _class "modal-content" ] [
button [ _type "button"; _class "btn-close"; _data "bs-dismiss" "modal"; _ariaLabel "Close" ] [] div [ _class "modal-header" ] [
] h5 [ _class "modal-title"; _id "nodesModalLabel" ] [ str "Add Notes to Prayer Request" ]
div [ _class "modal-body"; _id "snoozeBody" ] [ ] button [ _type "button"; _class "btn-close"; _data "bs-dismiss" "modal"; _ariaLabel "Close" ] []
div [ _class "modal-footer" ] [ ]
button [ _type "button"; _id "snoozeDismiss"; _class "btn btn-secondary"; _data "bs-dismiss" "modal" ] [ div [ _class "modal-body"; _id "notesBody" ] [ ]
str "Close" 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 /// The journal items
let journalItems now items = let journalItems now items =
match items |> List.isEmpty with match items |> List.isEmpty with
| true -> | true ->
noResults "No Active Requests" "/request/new/edit" "Add a Request" [ noResults "No Active Requests" "/request/new/edit" "Add a Request" [
rawText "You have no requests to be shown; see the &ldquo;Active&rdquo; link above for snoozed or deferred " rawText "You have no requests to be shown; see the &ldquo;Active&rdquo; link above for snoozed or deferred "
rawText "requests, and the &ldquo;Answered&rdquo; link for answered requests" rawText "requests, and the &ldquo;Answered&rdquo; link for answered requests"
] ]
| false -> | false ->
items items
|> List.map (journalCard now) |> List.map (journalCard now)
|> section [ |> section [ _id "journalItems"
_id "journalItems" _class "row row-cols-1 row-cols-md-2 row-cols-lg-3 row-cols-xl-4 g-3"
_class "row row-cols-1 row-cols-md-2 row-cols-lg-3 row-cols-xl-4 g-3" _hxTarget "this"
_hxTarget "this" _hxSwap HxSwap.OuterHtml ]
_hxSwap HxSwap.OuterHtml
]
/// The notes edit modal body /// The notes edit modal body
let notesEdit requestId = let notesEdit requestId =
let reqId = RequestId.toString requestId let reqId = RequestId.toString requestId
[ form [ _hxPost $"/request/{reqId}/note" ] [ [ form [ _hxPost $"/request/{reqId}/note" ] [
div [ _class "form-floating pb-3" ] [ div [ _class "form-floating pb-3" ] [
textarea [ textarea [ _id "notes"
_id "notes" _name "notes"
_name "notes" _class "form-control"
_class "form-control" _style "min-height: 8rem;"
_style "min-height: 8rem;" _placeholder "Notes"
_placeholder "Notes" _autofocus; _required ] [ ]
_autofocus; _required label [ _for "notes" ] [ str "Notes" ]
] [ ] ]
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" ] [
hr [ _style "margin: .5rem -1rem" ] p [ _class "text-center pt-3" ] [
div [ _id "priorNotes" ] [ button [ _type "button"
p [ _class "text-center pt-3" ] [ _class "btn btn-secondary"
button [ _hxGet $"/components/request/{reqId}/notes"
_type "button" _hxSwap HxSwap.OuterHtml
_class "btn btn-secondary" _hxTarget "#priorNotes" ] [
_hxGet $"/components/request/{reqId}/notes" str "Load Prior Notes"
_hxSwap HxSwap.OuterHtml ]
_hxTarget "#priorNotes" ]
] [str "Load Prior Notes" ]
] ]
]
] ]
/// The snooze edit form /// The snooze edit form
let snooze requestId = let snooze requestId =
let today = System.DateTime.Today.ToString "yyyy-MM-dd" let today = System.DateTime.Today.ToString "yyyy-MM-dd"
form [ form [ _hxPatch $"/request/{RequestId.toString requestId}/snooze"
_hxPatch $"/request/{RequestId.toString requestId}/snooze" _hxTarget "#journalItems"
_hxTarget "#journalItems" _hxSwap HxSwap.OuterHtml ] [
_hxSwap HxSwap.OuterHtml div [ _class "form-floating pb-3" ] [
] [ input [ _type "date"; _id "until"; _name "until"; _class "form-control"; _min today; _required ]
div [ _class "form-floating pb-3" ] [ label [ _for "until" ] [ str "Until" ]
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" ] ]
]
p [ _class "text-end mb-0" ] [ button [ _type "submit"; _class "btn btn-primary" ] [ str "Snooze" ] ]
] ]

219
src/MyPrayerJournal/Views/Layout.fs
View File

@ -7,141 +7,144 @@ open Giraffe.ViewEngine
open Giraffe.ViewEngine.Accessibility open Giraffe.ViewEngine.Accessibility
/// The data needed to render a page-level view /// The data needed to render a page-level view
type PageRenderContext = { type PageRenderContext =
/// Whether the user is authenticated { /// Whether the user is authenticated
isAuthenticated : bool isAuthenticated : bool
/// Whether the user has snoozed requests
hasSnoozed : bool /// Whether the user has snoozed requests
/// The current URL hasSnoozed : bool
currentUrl : string
/// The title for the page to be rendered /// The current URL
pageTitle : string currentUrl : string
/// The content of the page
content : XmlNode /// The title for the page to be rendered
} pageTitle : string
/// The content of the page
content : XmlNode
}
/// The home page /// The home page
let home = article [ _class "container mt-3" ] [ let home =
p [] [ rawText "&nbsp;" ] article [ _class "container mt-3" ] [
p [] [ p [] [ rawText "&nbsp;" ]
str "myPrayerJournal is a place where individuals can record their prayer requests, record that they prayed for " p [] [
str "them, update them as God moves in the situation, and record a final answer received on that request. It also " str "myPrayerJournal is a place where individuals can record their prayer requests, record that they "
str "allows individuals to review their answered prayers." 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 "&ldquo;Log On&rdquo; link above, and log on with either a Microsoft or Google account. You can "
rawText "also learn more about the site at the &ldquo;Docs&rdquo; link, also above."
]
] ]
p [] [
str "This site is open and available to the general public. To get started, simply click the "
rawText "&ldquo;Log On&rdquo; link above, and log on with either a Microsoft or Google account. You can also "
rawText "learn more about the site at the &ldquo;Docs&rdquo; link, also above."
]
]
/// The default navigation bar, which will load the items on page load, and whenever a refresh event occurs /// The default navigation bar, which will load the items on page load, and whenever a refresh event occurs
let private navBar ctx = let private navBar ctx =
nav [ _class "navbar navbar-dark"; _roleNavigation ] [ nav [ _class "navbar navbar-dark"; _roleNavigation ] [
div [ _class "container-fluid" ] [ div [ _class "container-fluid" ] [
pageLink "/" [ _class "navbar-brand" ] [ pageLink "/" [ _class "navbar-brand" ] [
span [ _class "m" ] [ str "my" ] span [ _class "m" ] [ str "my" ]
span [ _class "p" ] [ str "Prayer" ] span [ _class "p" ] [ str "Prayer" ]
span [ _class "j" ] [ str "Journal" ] span [ _class "j" ] [ str "Journal" ]
] ]
seq { seq {
let navLink (matchUrl : string) = let navLink (matchUrl : string) =
match ctx.currentUrl.StartsWith matchUrl with true -> [ _class "is-active-route" ] | false -> [] match ctx.currentUrl.StartsWith matchUrl with true -> [ _class "is-active-route" ] | false -> []
|> pageLink matchUrl |> pageLink matchUrl
match ctx.isAuthenticated with if ctx.isAuthenticated then
| true -> li [ _class "nav-item" ] [ navLink "/journal" [ str "Journal" ] ]
li [ _class "nav-item" ] [ navLink "/journal" [ str "Journal" ] ] li [ _class "nav-item" ] [ navLink "/requests/active" [ str "Active" ] ]
li [ _class "nav-item" ] [ navLink "/requests/active" [ str "Active" ] ] if ctx.hasSnoozed then li [ _class "nav-item" ] [ navLink "/requests/snoozed" [ str "Snoozed" ] ]
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" ] [ navLink "/requests/answered" [ str "Answered" ] ] li [ _class "nav-item" ] [ a [ _href "/user/log-off" ] [ str "Log Off" ] ]
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" ] ]
| false -> li [ _class "nav-item"] [ a [ _href "/user/log-on" ] [ str "Log On" ] ] li [ _class "nav-item" ] [
li [ _class "nav-item" ] [ a [ _href "https://docs.prayerjournal.me"; _target "_blank"; _rel "noopener" ] [ str "Docs" ]
a [ _href "https://docs.prayerjournal.me"; _target "_blank"; _rel "noopener" ] [ str "Docs" ] ]
] }
} |> List.ofSeq
|> List.ofSeq |> ul [ _class "navbar-nav me-auto d-flex flex-row" ]
|> ul [ _class "navbar-nav me-auto d-flex flex-row" ] ]
]
] ]
/// The title tag with the application name appended /// The title tag with the application name appended
let titleTag ctx = title [] [ str ctx.pageTitle; rawText " &#xab; myPrayerJournal" ] let titleTag ctx =
title [] [ str ctx.pageTitle; rawText " &#xab; myPrayerJournal" ]
/// The HTML `head` element /// The HTML `head` element
let htmlHead ctx = let htmlHead ctx =
head [ _lang "en" ] [ head [ _lang "en" ] [
meta [ _name "viewport"; _content "width=device-width, initial-scale=1" ] meta [ _name "viewport"; _content "width=device-width, initial-scale=1" ]
meta [ _name "description"; _content "Online prayer journal - free w/Google or Microsoft account" ] meta [ _name "description"; _content "Online prayer journal - free w/Google or Microsoft account" ]
titleTag ctx titleTag ctx
link [ link [ _href "https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/css/bootstrap.min.css"
_href "https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/css/bootstrap.min.css" _rel "stylesheet"
_rel "stylesheet" _integrity "sha384-EVSTQN3/azprG1Anm3QDgpJLIm9Nao0Yz1ztcQTwFspd3yD65VohhpuuCOmLASjC"
_integrity "sha384-EVSTQN3/azprG1Anm3QDgpJLIm9Nao0Yz1ztcQTwFspd3yD65VohhpuuCOmLASjC" _crossorigin "anonymous" ]
_crossorigin "anonymous" link [ _href "https://fonts.googleapis.com/icon?family=Material+Icons"; _rel "stylesheet" ]
] link [ _href "/style/style.css"; _rel "stylesheet" ]
link [ _href "https://fonts.googleapis.com/icon?family=Material+Icons"; _rel "stylesheet" ]
link [ _href "/style/style.css"; _rel "stylesheet" ]
] ]
/// Element used to display toasts /// Element used to display toasts
let toaster = let toaster =
div [ _ariaLive "polite"; _ariaAtomic "true"; _id "toastHost" ] [ div [ _ariaLive "polite"; _ariaAtomic "true"; _id "toastHost" ] [
div [ _class "toast-container position-absolute p-3 bottom-0 end-0"; _id "toasts" ] [] div [ _class "toast-container position-absolute p-3 bottom-0 end-0"; _id "toasts" ] []
] ]
/// The page's `footer` element /// The page's `footer` element
let htmlFoot = let htmlFoot =
footer [ _class "container-fluid" ] [ footer [ _class "container-fluid" ] [
p [ _class "text-muted text-end" ] [ p [ _class "text-muted text-end" ] [
str "myPrayerJournal v3" str "myPrayerJournal v3"
br [] br []
em [] [ em [] [
small [] [ small [] [
pageLink "/legal/privacy-policy" [] [ str "Privacy Policy" ] pageLink "/legal/privacy-policy" [] [ str "Privacy Policy" ]
rawText " &bull; " rawText " &bull; "
pageLink "/legal/terms-of-service" [] [ str "Terms of Service" ] pageLink "/legal/terms-of-service" [] [ str "Terms of Service" ]
rawText " &bull; " rawText " &bull; "
a [ _href "https://github.com/bit-badger/myprayerjournal"; _target "_blank"; _rel "noopener" ] [ a [ _href "https://github.com/bit-badger/myprayerjournal"; _target "_blank"; _rel "noopener" ] [
str "Developed" 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
Htmx.Script.minified script [] [
script [] [ rawText "if (!htmx) document.write('<script src=\"/script/htmx-1.5.0.min.js\"><\/script>')"
rawText "if (!htmx) document.write('<script src=\"/script/htmx-1.5.0.min.js\"><\/script>')" ]
] script [ _async
script [ _src "https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/js/bootstrap.bundle.min.js"
_async _integrity "sha384-MrcW6ZMFYlzcLA8Nl+NtUVF0sA7MsXsP1UyJoMp4YLEuNSfAP+JcXn/tWtIaxVXM"
_src "https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/js/bootstrap.bundle.min.js" _crossorigin "anonymous" ] []
_integrity "sha384-MrcW6ZMFYlzcLA8Nl+NtUVF0sA7MsXsP1UyJoMp4YLEuNSfAP+JcXn/tWtIaxVXM" script [] [
_crossorigin "anonymous" rawText "setTimeout(function () { "
] [] rawText "if (!bootstrap) document.write('<script src=\"/script/bootstrap.bundle.min.js\"><\/script>') "
script [] [ rawText "}, 2000)"
rawText "setTimeout(function () { " ]
rawText "if (!bootstrap) document.write('<script src=\"/script/bootstrap.bundle.min.js\"><\/script>') " script [ _src "/script/mpj.js" ] []
rawText "}, 2000)"
]
script [ _src "/script/mpj.js" ] []
] ]
/// Create the full view of the page /// Create the full view of the page
let view ctx = let view ctx =
html [ _lang "en" ] [ html [ _lang "en" ] [
htmlHead ctx htmlHead ctx
body [] [ body [] [
section [ _id "top" ] [ navBar ctx; main [ _roleMain ] [ ctx.content ] ] section [ _id "top"; _ariaLabel "Top navigation" ] [ navBar ctx; main [ _roleMain ] [ ctx.content ] ]
toaster toaster
htmlFoot htmlFoot
] ]
] ]
/// Create a partial view /// Create a partial view
let partial ctx = let partial ctx =
html [ _lang "en" ] [ html [ _lang "en" ] [
head [] [ titleTag ctx ] head [] [ titleTag ctx ]
body [] [ navBar ctx; main [ _roleMain ] [ ctx.content ] ] body [] [ navBar ctx; main [ _roleMain ] [ ctx.content ] ]
] ]

291
src/MyPrayerJournal/Views/Legal.fs
View File

@ -4,150 +4,159 @@ module MyPrayerJournal.Views.Legal
open Giraffe.ViewEngine open Giraffe.ViewEngine
/// View for the "Privacy Policy" page /// View for the "Privacy Policy" page
let privacyPolicy = article [ _class "container mt-3" ] [ let privacyPolicy =
h2 [ _class "mb-2" ] [ str "Privacy Policy" ] article [ _class "container mt-3" ] [
h6 [ _class "text-muted pb-3" ] [ str "as of May 21"; sup [] [ str "st"]; str ", 2018" ] h2 [ _class "mb-2" ] [ str "Privacy Policy" ]
p [] [ h6 [ _class "text-muted pb-3" ] [ str "as of May 21"; sup [] [ str "st"]; str ", 2018" ]
str "The nature of the service is one where privacy is a must. The items below will help you understand the data " p [] [
str "we collect, access, and store on your behalf as you use this service." str "The nature of the service is one where privacy is a must. The items below will help you understand "
str "the data we collect, access, and store on your behalf as you use this service."
]
div [ _class "card" ] [
div [ _class "list-group list-group-flush" ] [
div [ _class "list-group-item"] [
h3 [] [ str "Third Party Services" ]
p [ _class "card-text" ] [
str "myPrayerJournal utilizes a third-party authentication and identity provider. You should "
str "familiarize yourself with the privacy policy for "
a [ _href "https://auth0.com/privacy"; _target "_blank" ] [ str "Auth0" ]
str ", as well as your chosen provider ("
a [ _href "https://privacy.microsoft.com/en-us/privacystatement"; _target "_blank" ] [
str "Microsoft"
]
str " or "
a [ _href "https://policies.google.com/privacy"; _target "_blank" ] [ str "Google" ]
str ")."
]
]
div [ _class "list-group-item" ] [
h3 [] [ str "What We Collect" ]
h4 [] [ str "Identifying Data" ]
ul [] [
li [] [
str "The only identifying data myPrayerJournal stores is the subscriber "
rawText "(&ldquo;sub&rdquo;) field from the token we receive from Auth0, once you have "
str "signed in through their hosted service. All information is associated with you via "
str "this field."
]
li [] [
str "While you are signed in, within your browser, the service has access to your first "
str "and last names, along with a URL to the profile picture (provided by your selected "
str "identity provider). This information is not transmitted to the server, and is removed "
rawText "when &ldquo;Log Off&rdquo; is clicked."
]
]
h4 [] [ str "User Provided Data" ]
ul [ _class "mb-0" ] [
li [] [
str "myPrayerJournal stores the information you provide, including the text of prayer "
str "requests, updates, and notes; and the date/time when certain actions are taken."
]
]
]
div [ _class "list-group-item" ] [
h3 [] [ str "How Your Data Is Accessed / Secured" ]
ul [ _class "mb-0" ] [
li [] [
str "Your provided data is returned to you, as required, to display your journal or your "
str "answered requests. On the server, it is stored in a controlled-access database."
]
li [] [
str "Your data is backed up, along with other Bit Badger Solutions hosted systems, in a "
str "rolling manner; backups are preserved for the prior 7 days, and backups from the 1"
sup [] [ str "st" ]
str " and 15"
sup [] [ str "th" ]
str " are preserved for 3 months. These backups are stored in a private cloud data "
str "repository."
]
li [] [
str "The data collected and stored is the absolute minimum necessary for the functionality "
rawText "of the service. There are no plans to &ldquo;monetize&rdquo; this service, and "
str "storing the minimum amount of information means that the data we have is not "
str "interesting to purchasers (or those who may have more nefarious purposes)."
]
li [] [
str "Access to servers and backups is strictly controlled and monitored for unauthorized "
str "access attempts."
]
]
]
div [ _class "list-group-item" ] [
h3 [] [ str "Removing Your Data" ]
p [ _class "card-text" ] [
str "At any time, you may choose to discontinue using this service. Both Microsoft and Google "
str "provide ways to revoke access from this application. However, if you want your data "
str "removed from the database, please contact daniel at bitbadger.solutions (via e-mail, "
str "replacing at with @) prior to doing so, to ensure we can determine which subscriber ID "
str "belongs to you."
]
]
]
]
] ]
div [ _class "card" ] [
div [ _class "list-group list-group-flush" ] [
div [ _class "list-group-item"] [
h3 [] [ str "Third Party Services" ]
p [ _class "card-text" ] [
str "myPrayerJournal utilizes a third-party authentication and identity provider. You should familiarize "
str "yourself with the privacy policy for "
a [ _href "https://auth0.com/privacy"; _target "_blank" ] [ str "Auth0" ]
str ", as well as your chosen provider ("
a [ _href "https://privacy.microsoft.com/en-us/privacystatement"; _target "_blank" ] [ str "Microsoft"]
str " or "
a [ _href "https://policies.google.com/privacy"; _target "_blank" ] [ str "Google" ]
str ")."
]
]
div [ _class "list-group-item" ] [
h3 [] [ str "What We Collect" ]
h4 [] [ str "Identifying Data" ]
ul [] [
li [] [
rawText "The only identifying data myPrayerJournal stores is the subscriber (&ldquo;sub&rdquo;) field from "
str "the token we receive from Auth0, once you have signed in through their hosted service. All "
str "information is associated with you via this field."
]
li [] [
str "While you are signed in, within your browser, the service has access to your first and last names, "
str "along with a URL to the profile picture (provided by your selected identity provider). This "
rawText "information is not transmitted to the server, and is removed when &ldquo;Log Off&rdquo; is "
str "clicked."
]
]
h4 [] [ str "User Provided Data" ]
ul [ _class "mb-0" ] [
li [] [
str "myPrayerJournal stores the information you provide, including the text of prayer requests, updates, "
str "and notes; and the date/time when certain actions are taken."
]
]
]
div [ _class "list-group-item" ] [
h3 [] [ str "How Your Data Is Accessed / Secured" ]
ul [ _class "mb-0" ] [
li [] [
str "Your provided data is returned to you, as required, to display your journal or your answered "
str "requests. On the server, it is stored in a controlled-access database."
]
li [] [
str "Your data is backed up, along with other Bit Badger Solutions hosted systems, in a rolling manner; "
str "backups are preserved for the prior 7 days, and backups from the 1"
sup [] [ str "st" ]
str " and 15"
sup [] [ str "th" ]
str " are preserved for 3 months. These backups are stored in a private cloud data repository."
]
li [] [
str "The data collected and stored is the absolute minimum necessary for the functionality of the service. "
rawText "There are no plans to &ldquo;monetize&rdquo; this service, and storing the minimum amount of "
str "information means that the data we have is not interesting to purchasers (or those who may have more "
str "nefarious purposes)."
]
li [] [
str "Access to servers and backups is strictly controlled and monitored for unauthorized access attempts."
]
]
]
div [ _class "list-group-item" ] [
h3 [] [ str "Removing Your Data" ]
p [ _class "card-text" ] [
str "At any time, you may choose to discontinue using this service. Both Microsoft and Google provide ways "
str "to revoke access from this application. However, if you want your data removed from the database, "
str "please contact daniel at bitbadger.solutions (via e-mail, replacing at with @) prior to doing so, to "
str "ensure we can determine which subscriber ID belongs to you."
]
]
]
]
]
/// View for the "Terms of Service" page /// View for the "Terms of Service" page
let termsOfService = article [ _class "container mt-3" ] [ let termsOfService =
h2 [ _class "mb-2" ] [ str "Terms of Service" ] article [ _class "container mt-3" ] [
h6 [ _class "text-muted pb-3"] [ str "as of May 21"; sup [] [ str "st" ]; str ", 2018" ] h2 [ _class "mb-2" ] [ str "Terms of Service" ]
div [ _class "card" ] [ h6 [ _class "text-muted pb-3"] [ str "as of May 21"; sup [] [ str "st" ]; str ", 2018" ]
div [ _class "list-group list-group-flush" ] [ div [ _class "card" ] [
div [ _class "list-group-item" ] [ div [ _class "list-group list-group-flush" ] [
h3 [] [ str "1. Acceptance of Terms" ] div [ _class "list-group-item" ] [
p [ _class "card-text" ] [ h3 [] [ str "1. Acceptance of Terms" ]
str "By accessing this web site, you are agreeing to be bound by these Terms and Conditions, and that you " p [ _class "card-text" ] [
str "are responsible to ensure that your use of this site complies with all applicable laws. Your continued " str "By accessing this web site, you are agreeing to be bound by these Terms and Conditions, "
str "use of this site implies your acceptance of these terms." str "and that you are responsible to ensure that your use of this site complies with all "
] str "applicable laws. Your continued use of this site implies your acceptance of these terms."
]
]
div [ _class "list-group-item" ] [
h3 [] [ str "2. Description of Service and Registration" ]
p [ _class "card-text" ] [
str "myPrayerJournal is a service that allows individuals to enter and amend their prayer "
str "requests. It requires no registration by itself, but access is granted based on a "
str "successful login with an external identity provider. See "
pageLink "/legal/privacy-policy" [] [ str "our privacy policy" ]
str " for details on how that information is accessed and stored."
]
]
div [ _class "list-group-item" ] [
h3 [] [ str "3. Third Party Services" ]
p [ _class "card-text" ] [
str "This service utilizes a third-party service provider for identity management. Review the "
str "terms of service for "
a [ _href "https://auth0.com/terms"; _target "_blank" ] [ str "Auth0"]
str ", as well as those for the selected authorization provider ("
a [ _href "https://www.microsoft.com/en-us/servicesagreement"; _target "_blank" ] [
str "Microsoft"
]
str " or "
a [ _href "https://policies.google.com/terms"; _target "_blank" ] [ str "Google" ]
str ")."
]
]
div [ _class "list-group-item" ] [
h3 [] [ str "4. Liability" ]
p [ _class "card-text" ] [
rawText "This service is provided &ldquo;as is&rdquo;, and no warranty (express or implied) "
str "exists. The service and its developers may not be held liable for any damages that may "
str "arise through the use of this service."
]
]
div [ _class "list-group-item" ] [
h3 [] [ str "5. Updates to Terms" ]
p [ _class "card-text" ] [
str "These terms and conditions may be updated at any time, and this service does not have the "
str "capability to notify users when these change. The date at the top of the page will be "
str "updated when any of the text of these terms is updated."
]
]
]
] ]
div [ _class "list-group-item" ] [ p [ _class "pt-3" ] [
h3 [] [ str "2. Description of Service and Registration" ] str "You may also wish to review our "
p [ _class "card-text" ] [ pageLink "/legal/privacy-policy" [] [ str "privacy policy" ]
str "myPrayerJournal is a service that allows individuals to enter and amend their prayer requests. It " str " to learn how we handle your data."
str "requires no registration by itself, but access is granted based on a successful login with an external "
str "identity provider. See "
pageLink "/legal/privacy-policy" [] [ str "our privacy policy" ]
str " for details on how that information is accessed and stored."
]
] ]
div [ _class "list-group-item" ] [
h3 [] [ str "3. Third Party Services" ]
p [ _class "card-text" ] [
str "This service utilizes a third-party service provider for identity management. Review the terms of "
str "service for "
a [ _href "https://auth0.com/terms"; _target "_blank" ] [ str "Auth0"]
str ", as well as those for the selected authorization provider ("
a [ _href "https://www.microsoft.com/en-us/servicesagreement"; _target "_blank" ] [ str "Microsoft"]
str " or "
a [ _href "https://policies.google.com/terms"; _target "_blank" ] [ str "Google" ]
str ")."
]
]
div [ _class "list-group-item" ] [
h3 [] [ str "4. Liability" ]
p [ _class "card-text" ] [
rawText "This service is provided &ldquo;as is&rdquo;, and no warranty (express or implied) exists. The "
str "service and its developers may not be held liable for any damages that may arise through the use of "
str "this service."
]
]
div [ _class "list-group-item" ] [
h3 [] [ str "5. Updates to Terms" ]
p [ _class "card-text" ] [
str "These terms and conditions may be updated at any time, and this service does not have the capability to "
str "notify users when these change. The date at the top of the page will be updated when any of the text of "
str "these terms is updated."
]
]
]
] ]
p [ _class "pt-3" ] [
str "You may also wish to review our "
pageLink "/legal/privacy-policy" [] [ str "privacy policy" ]
str " to learn how we handle your data."
]
]

468
src/MyPrayerJournal/Views/Request.fs
View File

@ -8,268 +8,260 @@ open NodaTime
/// Create a request within the list /// Create a request within the list
let reqListItem now req = let reqListItem now req =
let reqId = RequestId.toString req.requestId let reqId = RequestId.toString req.requestId
let isAnswered = req.lastStatus = Answered let isAnswered = req.lastStatus = Answered
let isSnoozed = req.snoozedUntil > now let isSnoozed = req.snoozedUntil > now
let isPending = (not isSnoozed) && req.showAfter > now let isPending = (not isSnoozed) && req.showAfter > now
let btnClass = _class "btn btn-light mx-2" let btnClass = _class "btn btn-light mx-2"
let restoreBtn (link : string) title = let restoreBtn (link : string) title =
button [ btnClass; _hxPatch $"/request/{reqId}/{link}"; _title title ] [ icon "restore" ] button [ btnClass; _hxPatch $"/request/{reqId}/{link}"; _title title ] [ icon "restore" ]
div [ _class "list-group-item px-0 d-flex flex-row align-items-start"; _hxTarget "this"; _hxSwap HxSwap.OuterHtml ] [ div [ _class "list-group-item px-0 d-flex flex-row align-items-start"
pageLink $"/request/{reqId}/full" [ btnClass; _title "View Full Request" ] [ icon "description" ] _hxTarget "this"
match isAnswered with _hxSwap HxSwap.OuterHtml ] [
| true -> () pageLink $"/request/{reqId}/full" [ btnClass; _title "View Full Request" ] [ icon "description" ]
| false -> pageLink $"/request/{reqId}/edit" [ btnClass; _title "Edit Request" ] [ icon "edit" ] if not isAnswered then pageLink $"/request/{reqId}/edit" [ btnClass; _title "Edit Request" ] [ icon "edit" ]
match true with if isSnoozed then restoreBtn "cancel-snooze" "Cancel Snooze"
| _ when isSnoozed -> restoreBtn "cancel-snooze" "Cancel Snooze" elif isPending then restoreBtn "show" "Show Now"
| _ when isPending -> restoreBtn "show" "Show Now" p [ _class "request-text mb-0" ] [
| _ -> () str req.text
p [ _class "request-text mb-0" ] [ if isSnoozed || isPending || isAnswered then
str req.text br []
match isSnoozed || isPending || isAnswered with small [ _class "text-muted" ] [
| true -> if isSnoozed then [ str "Snooze expires "; relativeDate req.snoozedUntil now ]
br [] elif isPending then [ str "Request appears next "; relativeDate req.showAfter now ]
small [ _class "text-muted" ] [ else (* isAnswered *) [ str "Answered "; relativeDate req.asOf now ]
match () with |> em []
| _ when isSnoozed -> [ str "Snooze expires "; relativeDate req.snoozedUntil now ] ]
| _ when isPending -> [ str "Request appears next "; relativeDate req.showAfter now ] ]
| _ (* isAnswered *) -> [ str "Answered "; relativeDate req.asOf now ]
|> em []
]
| false -> ()
]
] ]
/// Create a list of requests /// Create a list of requests
let reqList now reqs = let reqList now reqs =
reqs reqs
|> List.map (reqListItem now) |> List.map (reqListItem now)
|> div [ _class "list-group" ] |> div [ _class "list-group" ]
/// View for Active Requests page /// View for Active Requests page
let active now reqs = article [ _class "container mt-3" ] [ let active now reqs =
h2 [ _class "pb-3" ] [ str "Active Requests" ] article [ _class "container mt-3" ] [
match reqs |> List.isEmpty with h2 [ _class "pb-3" ] [ str "Active Requests" ]
| true -> if List.isEmpty reqs then
noResults "No Active Requests" "/journal" "Return to your journal" noResults "No Active Requests" "/journal" "Return to your journal"
[ str "Your prayer journal has no active requests" ] [ str "Your prayer journal has no active requests" ]
| false -> reqList now reqs else reqList now reqs
] ]
/// View for Answered Requests page /// View for Answered Requests page
let answered now reqs = article [ _class "container mt-3" ] [ let answered now reqs =
h2 [ _class "pb-3" ] [ str "Answered Requests" ] article [ _class "container mt-3" ] [
match reqs |> List.isEmpty with h2 [ _class "pb-3" ] [ str "Answered Requests" ]
| true -> if List.isEmpty reqs then
noResults "No Active Requests" "/journal" "Return to your journal" [ noResults "No Active Requests" "/journal" "Return to your journal" [
rawText "Your prayer journal has no answered requests; once you have marked one as &ldquo;Answered&rdquo;, " str "Your prayer journal has no answered requests; once you have marked one as "
str "it will appear here" rawText "&ldquo;Answered&rdquo;, it will appear here"
] ]
| false -> reqList now reqs else reqList now reqs
] ]
/// View for Snoozed Requests page /// View for Snoozed Requests page
let snoozed now reqs = article [ _class "container mt-3" ] [ let snoozed now reqs =
h2 [ _class "pb-3" ] [ str "Snoozed Requests" ] article [ _class "container mt-3" ] [
reqList now reqs h2 [ _class "pb-3" ] [ str "Snoozed Requests" ]
] reqList now reqs
]
/// View for Full Request page /// View for Full Request page
let full (clock : IClock) (req : Request) = let full (clock : IClock) (req : Request) =
let now = clock.GetCurrentInstant () let now = clock.GetCurrentInstant ()
let answered = let answered =
req.history req.history
|> List.filter RequestAction.isAnswered |> List.filter RequestAction.isAnswered
|> List.tryHead |> List.tryHead
|> Option.map (fun x -> x.asOf) |> Option.map (fun x -> x.asOf)
let prayed = (req.history |> List.filter RequestAction.isPrayed |> List.length).ToString "N0" let prayed = (req.history |> List.filter RequestAction.isPrayed |> List.length).ToString "N0"
let daysOpen = let daysOpen =
let asOf = defaultArg answered now let asOf = defaultArg answered now
((asOf - (req.history |> List.filter RequestAction.isCreated |> List.head).asOf).TotalDays |> int).ToString "N0" ((asOf - (req.history |> List.filter RequestAction.isCreated |> List.head).asOf).TotalDays |> int).ToString "N0"
let lastText = let lastText =
req.history req.history
|> List.filter (fun h -> Option.isSome h.text) |> List.filter (fun h -> Option.isSome h.text)
|> List.sortByDescending (fun h -> h.asOf) |> List.sortByDescending (fun h -> h.asOf)
|> List.map (fun h -> Option.get h.text) |> List.map (fun h -> Option.get h.text)
|> List.head |> List.head
// The history log including notes (and excluding the final entry for answered requests) // The history log including notes (and excluding the final entry for answered requests)
let log = let log =
let toDisp (h : History) = {| asOf = h.asOf; text = h.text; status = RequestAction.toString h.status |} let toDisp (h : History) = {| asOf = h.asOf; text = h.text; status = RequestAction.toString h.status |}
let all = let all =
req.notes req.notes
|> List.map (fun n -> {| asOf = n.asOf; text = Some n.notes; status = "Notes" |}) |> List.map (fun n -> {| asOf = n.asOf; text = Some n.notes; status = "Notes" |})
|> List.append (req.history |> List.map toDisp) |> List.append (req.history |> List.map toDisp)
|> List.sortByDescending (fun it -> it.asOf) |> List.sortByDescending (fun it -> it.asOf)
// Skip the first entry for answered requests; that info is already displayed // Skip the first entry for answered requests; that info is already displayed
match answered with Some _ -> all |> List.skip 1 | None -> all match answered with Some _ -> all |> List.skip 1 | None -> all
article [ _class "container mt-3" ] [ article [ _class "container mt-3" ] [
div [_class "card" ] [ div [_class "card" ] [
h5 [ _class "card-header" ] [ str "Full Prayer Request" ] h5 [ _class "card-header" ] [ str "Full Prayer Request" ]
div [ _class "card-body" ] [ div [ _class "card-body" ] [
h6 [ _class "card-subtitle text-muted mb-2"] [ h6 [ _class "card-subtitle text-muted mb-2"] [
match answered with match answered with
| Some date -> | Some date ->
str "Answered " str "Answered "
date.ToDateTimeOffset().ToString ("D", null) |> str date.ToDateTimeOffset().ToString ("D", null) |> str
str " (" str " ("
relativeDate date now relativeDate date now
rawText ") &bull; " rawText ") &bull; "
| None -> () | None -> ()
sprintf "Prayed %s times &bull; Open %s days" prayed daysOpen |> rawText sprintf "Prayed %s times &bull; Open %s days" prayed daysOpen |> rawText
] ]
p [ _class "card-text" ] [ str lastText ] p [ _class "card-text" ] [ str lastText ]
]
log
|> List.map (fun it ->
li [ _class "list-group-item" ] [
p [ _class "m-0" ] [
str it.status
rawText "&nbsp; "
small [] [ em [] [ it.asOf.ToDateTimeOffset().ToString ("D", null) |> str ] ]
]
match it.text with
| Some txt -> p [ _class "mt-2 mb-0" ] [ str txt ]
| None -> ()
])
|> ul [ _class "list-group list-group-flush" ]
] ]
log
|> List.map (fun it -> li [ _class "list-group-item" ] [
p [ _class "m-0" ] [
str it.status
rawText "&nbsp; "
small [] [ em [] [ it.asOf.ToDateTimeOffset().ToString ("D", null) |> str ] ]
]
match it.text with
| Some txt -> p [ _class "mt-2 mb-0" ] [ str txt ]
| None -> ()
])
|> ul [ _class "list-group list-group-flush" ]
]
] ]
/// View for the edit request component /// View for the edit request component
let edit (req : JournalRequest) returnTo isNew = let edit (req : JournalRequest) returnTo isNew =
let cancelLink = let cancelLink =
match returnTo with match returnTo with
| "active" -> "/requests/active" | "active" -> "/requests/active"
| "snoozed" -> "/requests/snoozed" | "snoozed" -> "/requests/snoozed"
| _ (* "journal" *) -> "/journal" | _ (* "journal" *) -> "/journal"
let recurCount = let recurCount =
match req.recurrence with match req.recurrence with
| Immediate -> None | Immediate -> None
| Hours h -> Some h | Hours h -> Some h
| Days d -> Some d | Days d -> Some d
| Weeks w -> Some w | Weeks w -> Some w
|> Option.map string |> Option.map string
|> Option.defaultValue "" |> Option.defaultValue ""
article [ _class "container" ] [ article [ _class "container" ] [
h2 [ _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" _hxPushUrl
_hxPushUrl "/request" |> match isNew with true -> _hxPost | false -> _hxPatch ] [
"/request" |> match isNew with true -> _hxPost | false -> _hxPatch input [ _type "hidden"
] [ _name "requestId"
input [ _value (match isNew with true -> "new" | false -> RequestId.toString req.requestId) ]
_type "hidden" input [ _type "hidden"; _name "returnTo"; _value returnTo ]
_name "requestId" div [ _class "form-floating pb-3" ] [
_value (match isNew with true -> "new" | false -> RequestId.toString req.requestId) textarea [ _id "requestText"
] _name "requestText"
input [ _type "hidden"; _name "returnTo"; _value returnTo ] _class "form-control"
div [ _class "form-floating pb-3" ] [ _style "min-height: 8rem;"
textarea [ _placeholder "Enter the text of the request"
_id "requestText" _autofocus; _required ] [ str req.text ]
_name "requestText" label [ _for "requestText" ] [ str "Prayer Request" ]
_class "form-control" ]
_style "min-height: 8rem;"
_placeholder "Enter the text of the request"
_autofocus; _required
] [ str req.text ]
label [ _for "requestText" ] [ str "Prayer Request" ]
]
br []
match isNew with
| true -> ()
| false ->
div [ _class "pb-3" ] [
label [] [ str "Also Mark As" ]
br [] br []
div [ _class "form-check form-check-inline" ] [ if not isNew then
input [ _type "radio"; _class "form-check-input"; _id "sU"; _name "status"; _value "Updated"; _checked ] div [ _class "pb-3" ] [
label [ _for "sU" ] [ str "Updated" ] label [] [ str "Also Mark As" ]
] br []
div [ _class "form-check form-check-inline" ] [ div [ _class "form-check form-check-inline" ] [
input [ _type "radio"; _class "form-check-input"; _id "sP"; _name "status"; _value "Prayed" ] input [ _type "radio"
label [ _for "sP" ] [ str "Prayed" ] _class "form-check-input"
] _id "sU"
div [ _class "form-check form-check-inline" ] [ _name "status"
input [ _type "radio"; _class "form-check-input"; _id "sA"; _name "status"; _value "Answered" ] _value "Updated"
label [ _for "sA" ] [ str "Answered" ] _checked ]
] label [ _for "sU" ] [ str "Updated" ]
]
div [ _class "form-check form-check-inline" ] [
input [ _type "radio"; _class "form-check-input"; _id "sP"; _name "status"; _value "Prayed" ]
label [ _for "sP" ] [ str "Prayed" ]
]
div [ _class "form-check form-check-inline" ] [
input [ _type "radio"; _class "form-check-input"; _id "sA"; _name "status"; _value "Answered" ]
label [ _for "sA" ] [ str "Answered" ]
]
]
div [ _class "row" ] [
div [ _class "col-12 offset-md-2 col-md-8 offset-lg-3 col-lg-6" ] [
p [] [
strong [] [ rawText "Recurrence &nbsp; " ]
em [ _class "text-muted" ] [ rawText "After prayer, request reappears&hellip;" ]
]
div [ _class "d-flex flex-row flex-wrap justify-content-center align-items-center" ] [
div [ _class "form-check mx-2" ] [
input [ _type "radio"
_class "form-check-input"
_id "rI"
_name "recurType"
_value "Immediate"
_onclick "mpj.edit.toggleRecurrence(event)"
match req.recurrence with Immediate -> _checked | _ -> () ]
label [ _for "rI" ] [ str "Immediately" ]
]
div [ _class "form-check mx-2"] [
input [ _type "radio"
_class "form-check-input"
_id "rO"
_name "recurType"
_value "Other"
_onclick "mpj.edit.toggleRecurrence(event)"
match req.recurrence with Immediate -> () | _ -> _checked ]
label [ _for "rO" ] [ rawText "Every&hellip;" ]
]
div [ _class "form-floating mx-2"] [
input [ _type "number"
_class "form-control"
_id "recurCount"
_name "recurCount"
_placeholder "0"
_value recurCount
_style "width:6rem;"
_required
match req.recurrence with Immediate -> _disabled | _ -> () ]
label [ _for "recurCount" ] [ str "Count" ]
]
div [ _class "form-floating mx-2" ] [
select [ _class "form-control"
_id "recurInterval"
_name "recurInterval"
_style "width:6rem;"
_required
match req.recurrence with Immediate -> _disabled | _ -> () ] [
option [ _value "Hours"; match req.recurrence with Hours _ -> _selected | _ -> () ] [
str "hours"
]
option [ _value "Days"; match req.recurrence with Days _ -> _selected | _ -> () ] [
str "days"
]
option [ _value "Weeks"; match req.recurrence with Weeks _ -> _selected | _ -> () ] [
str "weeks"
]
]
label [ _form "recurInterval" ] [ str "Interval" ]
]
]
]
] ]
div [ _class "row" ] [ div [ _class "text-end pt-3" ] [
div [ _class "col-12 offset-md-2 col-md-8 offset-lg-3 col-lg-6" ] [ button [ _class "btn btn-primary me-2"; _type "submit" ] [ icon "save"; str " Save" ]
p [] [ pageLink cancelLink [ _class "btn btn-secondary ms-2" ] [ icon "arrow_back"; str " Cancel" ]
strong [] [ rawText "Recurrence &nbsp; " ]
em [ _class "text-muted" ] [ rawText "After prayer, request reappears&hellip;" ]
] ]
div [ _class "d-flex flex-row flex-wrap justify-content-center align-items-center" ] [
div [ _class "form-check mx-2" ] [
input [
_type "radio"
_class "form-check-input"
_id "rI"
_name "recurType"
_value "Immediate"
_onclick "mpj.edit.toggleRecurrence(event)"
match req.recurrence with Immediate -> _checked | _ -> ()
]
label [ _for "rI" ] [ str "Immediately" ]
]
div [ _class "form-check mx-2"] [
input [
_type "radio"
_class "form-check-input"
_id "rO"
_name "recurType"
_value "Other"
_onclick "mpj.edit.toggleRecurrence(event)"
match req.recurrence with Immediate -> () | _ -> _checked
]
label [ _for "rO" ] [ rawText "Every&hellip;" ]
]
div [ _class "form-floating mx-2"] [
input [
_type "number"
_class "form-control"
_id "recurCount"
_name "recurCount"
_placeholder "0"
_value recurCount
_style "width:6rem;"
_required
match req.recurrence with Immediate -> _disabled | _ -> ()
]
label [ _for "recurCount" ] [ str "Count" ]
]
div [ _class "form-floating mx-2" ] [
select [
_class "form-control"
_id "recurInterval"
_name "recurInterval"
_style "width:6rem;"
_required
match req.recurrence with Immediate -> _disabled | _ -> ()
] [
option [ _value "Hours"; match req.recurrence with Hours _ -> _selected | _ -> () ] [ str "hours" ]
option [ _value "Days"; match req.recurrence with Days _ -> _selected | _ -> () ] [ str "days" ]
option [ _value "Weeks"; match req.recurrence with Weeks _ -> _selected | _ -> () ] [ str "weeks" ]
]
label [ _form "recurInterval" ] [ str "Interval" ]
]
]
]
] ]
div [ _class "text-end pt-3" ] [
button [ _class "btn btn-primary me-2"; _type "submit" ] [ icon "save"; str " Save" ]
pageLink cancelLink [ _class "btn btn-secondary ms-2" ] [ icon "arrow_back"; str " Cancel" ]
]
]
] ]
/// Display a list of notes for a request /// Display a list of notes for a request
let notes now notes = let notes now notes =
let toItem (note : Note) = let toItem (note : Note) =
p [] [ small [ _class "text-muted" ] [ relativeDate note.asOf now ]; br []; str note.notes ] p [] [ small [ _class "text-muted" ] [ relativeDate note.asOf now ]; br []; str note.notes ]
[ p [ _class "text-center" ] [ strong [] [ str "Prior Notes for This Request" ] ] [ 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
] ]