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

Version 3.1 (#71)

Browse Source 
- Fix request sorting
- Send time zone, so request actions are displayed in local time
- Make recurrence a true DU
- Tweak the data store representation of a few other fields
This commit is contained in:
Daniel J. Summers 2022-07-30 17:02:58 -04:00 committed by GitHub
parent a826275510
commit d621ede7bb
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
19 changed files with 1952 additions and 1676 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/MyPrayerJournal.ConvertRecurrence/MyPrayerJournal.ConvertRecurrence.fsproj Normal file
View File

@ -0,0 +1,16 @@
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<OutputType>Exe</OutputType>
<TargetFramework>net6.0</TargetFramework>
</PropertyGroup>
<ItemGroup>
<Compile Include="Program.fs" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\MyPrayerJournal\MyPrayerJournal.fsproj" />
</ItemGroup>
</Project>

114
src/MyPrayerJournal.ConvertRecurrence/Program.fs Normal file
View File

@ -0,0 +1,114 @@
open MyPrayerJournal.Domain
open NodaTime
/// The old definition of the history entry
[<CLIMutable; NoComparison; NoEquality>]
type OldHistory =
{ /// The time when this history entry was made
asOf : int64
/// 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 : int64
/// The text of the notes
notes : string
}
/// Request is the identifying record for a prayer request
[<CLIMutable; NoComparison; NoEquality>]
type OldRequest =
{ /// The ID of the request
id : RequestId
/// The time this request was initially entered
enteredOn : int64
/// 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 : int64
/// The time at which this request should reappear in the user's journal by recurrence
showAfter : int64
/// 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 : OldHistory[]
/// The notes for this request
notes : OldNote[]
}
open LiteDB
open MyPrayerJournal.Data
let db = new LiteDatabase ("Filename=./mpj.db")
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
/// Convert an old history entry to the new form
let convertHistory (old : OldHistory) =
{ AsOf = Instant.FromUnixTimeMilliseconds old.asOf
Status = old.status
Text = old.text
}
/// Convert an old note to the new form
let convertNote (old : OldNote) =
{ AsOf = Instant.FromUnixTimeMilliseconds old.asOf
Notes = old.notes
}
/// Convert items that may be Instant.MinValue or Instant(0) to None
let noneIfOld ms =
match Instant.FromUnixTimeMilliseconds ms with
| instant when instant > Instant.FromUnixTimeMilliseconds 0 -> Some instant
| _ -> None
/// Map the old request to the new request
let convert old =
{ Id = old.id
EnteredOn = Instant.FromUnixTimeMilliseconds old.enteredOn
UserId = old.userId
SnoozedUntil = noneIfOld old.snoozedUntil
ShowAfter = noneIfOld old.showAfter
Recurrence = mapRecurrence old
History = old.history |> Array.map convertHistory |> List.ofArray
Notes = old.notes |> Array.map convertNote |> List.ofArray
}
/// 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.GetCollection<OldRequest>("request").FindAll ()
|> Seq.map convert
|> List.ofSeq
|> List.iter replace
// For more information see https://aka.ms/fsharp-console-apps
printfn "Done"

28
src/MyPrayerJournal.sln Normal file
View File

@ -0,0 +1,28 @@

Microsoft Visual Studio Solution File, Format Version 12.00
# Visual Studio Version 16
VisualStudioVersion = 16.0.30114.105
MinimumVisualStudioVersion = 10.0.40219.1
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MyPrayerJournal", "MyPrayerJournal\MyPrayerJournal.fsproj", "{6BD5A3C8-F859-42A0-ACD7-A5819385E828}"
EndProject
Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MyPrayerJournal.ConvertRecurrence", "MyPrayerJournal.ConvertRecurrence\MyPrayerJournal.ConvertRecurrence.fsproj", "{72B57736-8721-4636-A309-49FA4222416E}"
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU
Release|Any CPU = Release|Any CPU
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE
EndGlobalSection
GlobalSection(ProjectConfigurationPlatforms) = postSolution
{6BD5A3C8-F859-42A0-ACD7-A5819385E828}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{6BD5A3C8-F859-42A0-ACD7-A5819385E828}.Debug|Any CPU.Build.0 = Debug|Any CPU
{6BD5A3C8-F859-42A0-ACD7-A5819385E828}.Release|Any CPU.ActiveCfg = Release|Any CPU
{6BD5A3C8-F859-42A0-ACD7-A5819385E828}.Release|Any CPU.Build.0 = Release|Any CPU
{72B57736-8721-4636-A309-49FA4222416E}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{72B57736-8721-4636-A309-49FA4222416E}.Debug|Any CPU.Build.0 = Debug|Any CPU
{72B57736-8721-4636-A309-49FA4222416E}.Release|Any CPU.ActiveCfg = Release|Any CPU
{72B57736-8721-4636-A309-49FA4222416E}.Release|Any CPU.Build.0 = Release|Any CPU
EndGlobalSection
EndGlobal

262
src/MyPrayerJournal/Data.fs
View File

@ -1,25 +1,23 @@
module MyPrayerJournal.Data module MyPrayerJournal.Data
open LiteDB open LiteDB
open NodaTime open MyPrayerJournal
open System
open System.Threading.Tasks open System.Threading.Tasks
// fsharplint:disable MemberNames
/// LiteDB extensions /// LiteDB extensions
[<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 = this.GetCollection<Request> "request"
/// Async version of the checkpoint command (flushes log)
member this.saveChanges () = /// Async version of the checkpoint command (flushes log)
this.Checkpoint () member this.SaveChanges () =
Task.CompletedTask this.Checkpoint ()
Task.CompletedTask
/// Map domain to LiteDB /// Map domain to LiteDB
@ -27,183 +25,175 @@ module Extensions =
[<RequireQualifiedAccess>] [<RequireQualifiedAccess>]
module Mapping = module Mapping =
/// Map a history entry to BSON open NodaTime
let historyToBson (hist : History) : BsonValue = open NodaTime.Text
let doc = BsonDocument ()
doc["asOf"] <- hist.asOf.ToUnixTimeMilliseconds ()
doc["status"] <- RequestAction.toString hist.status
doc["text"] <- match hist.text with Some t -> t | None -> ""
upcast doc
/// Map a BSON document to a history entry /// A NodaTime instant pattern to use for parsing instants from the database
let historyFromBson (doc : BsonValue) = let instantPattern = InstantPattern.CreateWithInvariantCulture "g"
{ asOf = Instant.FromUnixTimeMilliseconds doc["asOf"].AsInt64
status = RequestAction.ofString doc["status"].AsString
text = match doc["text"].AsString with "" -> None | txt -> Some txt
}
/// Map a note entry to BSON /// Mapping for NodaTime's Instant type
let noteToBson (note : Note) : BsonValue = module Instant =
let doc = BsonDocument () let fromBson (value : BsonValue) = (instantPattern.Parse value.AsString).Value
doc["asOf"] <- note.asOf.ToUnixTimeMilliseconds () let toBson (value : Instant) : BsonValue = value.ToString ("g", null)
doc["notes"] <- note.notes
upcast doc
/// Map a BSON document to a note entry /// Mapping for option types
let noteFromBson (doc : BsonValue) = module Option =
{ asOf = Instant.FromUnixTimeMilliseconds doc["asOf"].AsInt64 let instantFromBson (value : BsonValue) = if value.IsNull then None else Some (Instant.fromBson value)
notes = doc["notes"].AsString let instantToBson (value : Instant option) = match value with Some it -> Instant.toBson it | None -> null
}
/// Map a request to its BSON representation let stringFromBson (value : BsonValue) = match value.AsString with "" -> None | x -> Some x
let requestToBson req : BsonValue = let stringToBson (value : string option) : BsonValue = match value with Some txt -> txt | None -> ""
let doc = BsonDocument ()
doc["_id"] <- RequestId.toString req.id
doc["enteredOn"] <- req.enteredOn.ToUnixTimeMilliseconds ()
doc["userId"] <- UserId.toString req.userId
doc["snoozedUntil"] <- req.snoozedUntil.ToUnixTimeMilliseconds ()
doc["showAfter"] <- req.showAfter.ToUnixTimeMilliseconds ()
doc["recurType"] <- Recurrence.toString req.recurType
doc["recurCount"] <- BsonValue req.recurCount
doc["history"] <- BsonArray (req.history |> List.map historyToBson |> Seq.ofList)
doc["notes"] <- BsonArray (req.notes |> List.map noteToBson |> Seq.ofList)
upcast doc
/// Map a BSON document to a request /// Mapping for Recurrence
let requestFromBson (doc : BsonValue) = module Recurrence =
{ id = RequestId.ofString doc["_id"].AsString let fromBson (value : BsonValue) = Recurrence.ofString value
enteredOn = Instant.FromUnixTimeMilliseconds doc["enteredOn"].AsInt64 let toBson (value : Recurrence) : BsonValue = Recurrence.toString value
userId = UserId doc["userId"].AsString
snoozedUntil = Instant.FromUnixTimeMilliseconds doc["snoozedUntil"].AsInt64
showAfter = Instant.FromUnixTimeMilliseconds doc["showAfter"].AsInt64
recurType = Recurrence.ofString doc["recurType"].AsString
recurCount = int16 doc["recurCount"].AsInt32
history = doc["history"].AsArray |> Seq.map historyFromBson |> List.ofSeq
notes = doc["notes"].AsArray |> Seq.map noteFromBson |> List.ofSeq
}
/// Set up the mapping /// Mapping for RequestAction
let register () = module RequestAction =
BsonMapper.Global.RegisterType<Request>( let fromBson (value : BsonValue) = RequestAction.ofString value.AsString
Func<Request, BsonValue> requestToBson, Func<BsonValue, Request> requestFromBson) 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>(Instant.toBson, Instant.fromBson)
BsonMapper.Global.RegisterType<Instant option>(Option.instantToBson, Option.instantFromBson)
BsonMapper.Global.RegisterType<Recurrence>(Recurrence.toBson, Recurrence.fromBson)
BsonMapper.Global.RegisterType<RequestAction>(RequestAction.toBson, RequestAction.fromBson)
BsonMapper.Global.RegisterType<RequestId>(RequestId.toBson, RequestId.fromBson)
BsonMapper.Global.RegisterType<string option>(Option.stringToBson, Option.stringFromBson)
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 = Array.append [| 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 = Array.append [| 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 /// Find all requests for the given user
let private getRequestsForUser (userId : UserId) (db : LiteDatabase) = backgroundTask {
return! db.Requests.Find (Query.EQ (nameof Request.empty.UserId, Mapping.UserId.toBson userId)) |> toListAsync
}
/// 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 = backgroundTask {
let! reqs = db.requests.Find (Query.EQ ("userId", UserId.toString userId)) |> toListAsync let! reqs = getRequestsForUser userId db
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 = backgroundTask {
let! jrnl = db.requests.Find (Query.EQ ("userId", UserId.toString userId)) |> toListAsync let! reqs = getRequestsForUser userId db
return return
jrnl reqs
|> 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 -> defaultArg (r.SnoozedUntil |> Option.map (fun it -> it > now)) false)
} }
/// 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 recurCount 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 recurType = recurType; recurCount = recurCount } | 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"
} }

112
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.
@ -46,33 +46,31 @@ let twoMonths = 86_400.
open System open System
/// Convert from a JavaScript "ticks" value to a date/time /// Format the distance between two instants in approximate English terms
let fromJs ticks = DateTime.UnixEpoch + TimeSpan.FromTicks (ticks * 10_000L) let formatDistance (startOn : Instant) (endOn : 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 formatDistance (startDate : Instant) (endDate : Instant) = let diff = startOn - endOn
let format (token, number) locale = let minutes = Math.Abs diff.TotalMinutes
let labels = locales |> Map.find locale let formatToken =
match number with 1 -> fst labels[token] | _ -> sprintf (snd labels[token]) number let months = minutes / aMonth |> round
let round (it : float) = Math.Round it |> int 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 format formatToken "en-US"
let minutes = Math.Abs diff.TotalMinutes |> match startOn > endOn with true -> sprintf "%s ago" | false -> sprintf "in %s"
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"

403
src/MyPrayerJournal/Domain.fs
View File

@ -1,213 +1,280 @@
[<AutoOpen>] /// The data model for myPrayerJournal
/// The data model for myPrayerJournal [<AutoOpen>]
module MyPrayerJournal.Domain module MyPrayerJournal.Domain
// fsharplint:disable RecordFieldNames open System
open Cuid 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
| Hours /// A request should reappear immediately at the bottom of the list
| Days | Immediate
| Weeks
/// 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 /// 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 -> "Hours" | Immediate -> "Immediate"
| Days -> "Days" | Hours h -> $"{h} Hours"
| Weeks -> "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 =
| "Hours" -> Hours function
| "Days" -> Days | "Immediate" -> Immediate
| "Weeks" -> Weeks | it when it.Contains " " ->
| it -> invalidOp $"{it} is not a valid recurrence" let parts = it.Split " "
/// An hour's worth of seconds let length = Convert.ToInt16 parts[0]
let private oneHour = 3_600L match parts[1] with
/// The duration of the recurrence (in milliseconds) | "Hours" -> Hours length
let duration x = | "Days" -> Days length
(match x with | "Weeks" -> Weeks length
| Immediate -> 0L | _ -> invalidOp $"{parts[1]} is not a valid recurrence"
| Hours -> oneHour | it -> invalidOp $"{it} is not a valid recurrence"
| Days -> oneHour * 24L
| Weeks -> oneHour * 24L * 7L) /// 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 /// The action taken on a request as part of a history entry
type RequestAction = type RequestAction =
| Created | Created
| Prayed | Prayed
| Updated | Updated
| Answered | Answered
/// 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}"
/// 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
}
/// Functions to manipulate history entries
module History =
/// 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
/// 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 type of recurrence for this request SnoozedUntil : Instant option
recurType : Recurrence
/// 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 option
/// The history entries for this request
history : History list /// The recurrence for this request
/// The notes for this request Recurrence : Recurrence
notes : Note list
} /// The history entries for this request
with History : History[]
/// An empty request
static member empty = /// The notes for this request
{ id = Cuid.generate () |> RequestId Notes : Note[]
enteredOn = Instant.MinValue }
userId = UserId ""
snoozedUntil = Instant.MinValue /// Functions to support requests
showAfter = Instant.MinValue module Request =
recurType = Immediate
recurCount = 0s /// An empty request
history = [] let empty =
notes = [] { Id = Cuid.generate () |> RequestId
} EnteredOn = Instant.MinValue
UserId = UserId ""
SnoozedUntil = None
ShowAfter = None
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 time a request was marked as prayed
showAfter : Instant LastPrayed : Instant option
/// The type of recurrence for this request
recurType : Recurrence /// The last status for the request
/// How many of the recurrence intervals should occur between appearances in the journal LastStatus : RequestAction
recurCount : int16
/// History entries for the request /// The time that this request should reappear in the user's journal
history : History list SnoozedUntil : Instant option
/// Note entries for the request
notes : Note list /// The time after which this request should reappear in the user's journal by configured recurrence
} ShowAfter : Instant option
/// 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 lastHistory = req.History |> Array.sortByDescending (fun it -> it.AsOf) |> Array.tryHead
{ requestId = req.id // Requests are sorted by the "as of" field in this record; for sorting to work properly, we will put the
userId = req.userId // largest of the last prayed date, the "snoozed until". or the "show after" date; if none of those are filled,
text = req.history // we will use the last activity date. This will mean that:
|> List.filter (fun it -> Option.isSome it.text) // - Immediately shown requests will be at the top of the list, in order from least recently prayed to most.
|> List.sortByDescending (fun it -> it.asOf) // - Non-immediate requests will enter the list as if they were marked as prayed at that time; this will put
|> List.tryHead // them at the bottom of the list.
|> Option.map (fun h -> Option.get h.text) // - Snoozed requests will reappear at the bottom of the list when they return.
|> Option.defaultValue "" // - New requests will go to the bottom of the list, but will rise as others are marked as prayed.
asOf = match hist with Some h -> h.asOf | None -> Instant.MinValue let lastActivity = lastHistory |> Option.map (fun it -> it.AsOf) |> Option.defaultValue Instant.MinValue
lastStatus = match hist with Some h -> h.status | None -> Created let showAfter = defaultArg req.ShowAfter Instant.MinValue
snoozedUntil = req.snoozedUntil let snoozedUntil = defaultArg req.SnoozedUntil Instant.MinValue
showAfter = req.showAfter let lastPrayed =
recurType = req.recurType req.History
recurCount = req.recurCount |> Array.sortByDescending (fun it -> it.AsOf)
history = [] |> Array.filter History.isPrayed
notes = [] |> Array.tryHead
} |> Option.map (fun it -> it.AsOf)
|> Option.defaultValue Instant.MinValue
let asOf = List.max [ lastPrayed; showAfter; snoozedUntil ]
{ RequestId = req.Id
UserId = req.UserId
Text = req.History
|> Array.filter (fun it -> Option.isSome it.Text)
|> Array.sortByDescending (fun it -> it.AsOf)
|> Array.tryHead
|> Option.map (fun h -> Option.get h.Text)
|> Option.defaultValue ""
AsOf = if asOf > Instant.MinValue then asOf else lastActivity
LastPrayed = if lastPrayed = Instant.MinValue then None else Some lastPrayed
LastStatus = match lastHistory 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 /// Same as `ofRequestLite`, but with notes and history
let ofRequestFull req = let ofRequestFull req =
{ ofRequestLite req with { ofRequestLite req with
history = req.history History = List.ofArray req.History
notes = req.notes Notes = List.ofArray 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

954
src/MyPrayerJournal/Handlers.fs
View File

File diff suppressed because it is too large Load Diff

17
src/MyPrayerJournal/MyPrayerJournal.fsproj
View File

@ -1,7 +1,8 @@
<Project Sdk="Microsoft.NET.Sdk.Web"> <Project Sdk="Microsoft.NET.Sdk.Web">
<PropertyGroup> <PropertyGroup>
<TargetFramework>net6.0</TargetFramework> <TargetFramework>net6.0</TargetFramework>
<Version>3.0.0.0</Version> <Version>3.1.0</Version>
<NoWarn>3391</NoWarn>
</PropertyGroup> </PropertyGroup>
<ItemGroup> <ItemGroup>
<Compile Include="Domain.fs" /> <Compile Include="Domain.fs" />
@ -16,14 +17,14 @@
<Compile Include="Program.fs" /> <Compile Include="Program.fs" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<PackageReference Include="FSharp.SystemTextJson" Version="0.17.4" /> <PackageReference Include="FSharp.SystemTextJson" Version="0.19.13" />
<PackageReference Include="FunctionalCuid" Version="1.0.0" /> <PackageReference Include="FunctionalCuid" Version="1.0.0" />
<PackageReference Include="Giraffe" Version="5.0.0" /> <PackageReference Include="Giraffe" Version="6.0.0" />
<PackageReference Include="Giraffe.Htmx" Version="0.9.2" /> <PackageReference Include="Giraffe.Htmx" Version="1.8.0" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="0.9.2" /> <PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.8.0" />
<PackageReference Include="LiteDB" Version="5.0.11" /> <PackageReference Include="LiteDB" Version="5.0.12" />
<PackageReference Include="Microsoft.AspNetCore.Authentication.OpenIdConnect" Version="5.0.10" /> <PackageReference Include="Microsoft.AspNetCore.Authentication.OpenIdConnect" Version="6.0.7" />
<PackageReference Include="NodaTime" Version="3.0.9" /> <PackageReference Include="NodaTime" Version="3.1.0" />
</ItemGroup> </ItemGroup>
<ItemGroup> <ItemGroup>
<Folder Include="wwwroot\" /> <Folder Include="wwwroot\" />

278
src/MyPrayerJournal/Program.fs
View File

@ -7,175 +7,163 @@ open System.IO
/// Configuration functions for the application /// Configuration functions for the application
module Configure = module Configure =
/// Configure the content root /// Configure the content root
let contentRoot root = let contentRoot root =
WebApplicationOptions (ContentRootPath = root) |> WebApplication.CreateBuilder WebApplicationOptions (ContentRootPath = root) |> WebApplication.CreateBuilder
open Microsoft.Extensions.Configuration open Microsoft.Extensions.Configuration
/// Configure the application configuration /// Configure the application configuration
let appConfiguration (bldr : WebApplicationBuilder) = let appConfiguration (bldr : WebApplicationBuilder) =
bldr.Configuration bldr.Configuration
.SetBasePath(bldr.Environment.ContentRootPath) .SetBasePath(bldr.Environment.ContentRootPath)
.AddJsonFile("appsettings.json", optional = false, reloadOnChange = true) .AddJsonFile("appsettings.json", optional = false, reloadOnChange = true)
.AddJsonFile($"appsettings.{bldr.Environment.EnvironmentName}.json", optional = true, reloadOnChange = true) .AddJsonFile($"appsettings.{bldr.Environment.EnvironmentName}.json", optional = true, reloadOnChange = true)
.AddEnvironmentVariables () .AddEnvironmentVariables ()
|> ignore |> ignore
bldr bldr
open Microsoft.AspNetCore.Server.Kestrel.Core open Microsoft.AspNetCore.Server.Kestrel.Core
/// Configure Kestrel from appsettings.json /// Configure Kestrel from appsettings.json
let kestrel (bldr : WebApplicationBuilder) = let kestrel (bldr : WebApplicationBuilder) =
let kestrelOpts (ctx : WebHostBuilderContext) (opts : KestrelServerOptions) = let kestrelOpts (ctx : WebHostBuilderContext) (opts : KestrelServerOptions) =
(ctx.Configuration.GetSection >> opts.Configure >> ignore) "Kestrel" (ctx.Configuration.GetSection >> opts.Configure >> ignore) "Kestrel"
bldr.WebHost.UseKestrel().ConfigureKestrel kestrelOpts |> ignore bldr.WebHost.UseKestrel().ConfigureKestrel kestrelOpts |> ignore
bldr bldr
/// Configure the web root directory /// Configure the web root directory
let webRoot pathSegments (bldr : WebApplicationBuilder) = let webRoot pathSegments (bldr : WebApplicationBuilder) =
Array.concat [ [| bldr.Environment.ContentRootPath |]; pathSegments ] Array.concat [ [| bldr.Environment.ContentRootPath |]; pathSegments ]
|> (Path.Combine >> bldr.WebHost.UseWebRoot >> ignore) |> (Path.Combine >> bldr.WebHost.UseWebRoot >> ignore)
bldr bldr
open Microsoft.Extensions.Logging open Microsoft.Extensions.Logging
open Microsoft.Extensions.Hosting open Microsoft.Extensions.Hosting
/// Configure logging /// Configure logging
let logging (bldr : WebApplicationBuilder) = let logging (bldr : WebApplicationBuilder) =
match bldr.Environment.IsDevelopment () with if bldr.Environment.IsDevelopment () then bldr.Logging.AddFilter (fun l -> l > LogLevel.Information) |> ignore
| true -> () bldr.Logging.AddConsole().AddDebug() |> ignore
| false -> bldr.Logging.AddFilter (fun l -> l > LogLevel.Information) |> ignore bldr
bldr.Logging.AddConsole().AddDebug() |> ignore
bldr
open Giraffe open Giraffe
open LiteDB open LiteDB
open Microsoft.AspNetCore.Authentication.Cookies open Microsoft.AspNetCore.Authentication.Cookies
open Microsoft.AspNetCore.Authentication.OpenIdConnect open Microsoft.AspNetCore.Authentication.OpenIdConnect
open Microsoft.AspNetCore.Http open Microsoft.AspNetCore.Http
open Microsoft.Extensions.DependencyInjection open Microsoft.Extensions.DependencyInjection
open Microsoft.IdentityModel.Protocols.OpenIdConnect open Microsoft.IdentityModel.Protocols.OpenIdConnect
open NodaTime open NodaTime
open System open System
open System.Text.Json open System.Text.Json
open System.Text.Json.Serialization open System.Text.Json.Serialization
open System.Threading.Tasks open System.Threading.Tasks
/// Configure dependency injection /// Configure dependency injection
let services (bldr : WebApplicationBuilder) = let services (bldr : WebApplicationBuilder) =
let sameSite (opts : CookieOptions) = let sameSite (opts : CookieOptions) =
match opts.SameSite, opts.Secure with match opts.SameSite, opts.Secure with
| SameSiteMode.None, false -> opts.SameSite <- SameSiteMode.Unspecified | SameSiteMode.None, false -> opts.SameSite <- SameSiteMode.Unspecified
| _, _ -> () | _, _ -> ()
bldr.Services let _ = bldr.Services.AddRouting ()
.AddRouting() let _ = bldr.Services.AddGiraffe ()
.AddGiraffe() let _ = bldr.Services.AddSingleton<IClock> SystemClock.Instance
.AddSingleton<IClock>(SystemClock.Instance) let _ = bldr.Services.AddSingleton<IDateTimeZoneProvider> DateTimeZoneProviders.Tzdb
.Configure<CookiePolicyOptions>(
fun (opts : CookiePolicyOptions) ->
opts.MinimumSameSitePolicy <- SameSiteMode.Unspecified
opts.OnAppendCookie <- fun ctx -> sameSite ctx.CookieOptions
opts.OnDeleteCookie <- fun ctx -> sameSite ctx.CookieOptions)
.AddAuthentication(
/// Use HTTP "Bearer" authentication with JWTs
fun opts ->
opts.DefaultAuthenticateScheme <- CookieAuthenticationDefaults.AuthenticationScheme
opts.DefaultSignInScheme <- CookieAuthenticationDefaults.AuthenticationScheme
opts.DefaultChallengeScheme <- CookieAuthenticationDefaults.AuthenticationScheme)
.AddCookie()
.AddOpenIdConnect("Auth0",
/// Configure OIDC with Auth0 options from configuration
fun opts ->
let cfg = bldr.Configuration.GetSection "Auth0"
opts.Authority <- sprintf "https://%s/" cfg["Domain"]
opts.ClientId <- cfg["Id"]
opts.ClientSecret <- cfg["Secret"]
opts.ResponseType <- OpenIdConnectResponseType.Code
opts.Scope.Clear () let _ =
opts.Scope.Add "openid" bldr.Services.Configure<CookiePolicyOptions>(fun (opts : CookiePolicyOptions) ->
opts.Scope.Add "profile" opts.MinimumSameSitePolicy <- SameSiteMode.Unspecified
opts.OnAppendCookie <- fun ctx -> sameSite ctx.CookieOptions
opts.OnDeleteCookie <- fun ctx -> sameSite ctx.CookieOptions)
let _ =
bldr.Services.AddAuthentication(fun opts ->
opts.DefaultAuthenticateScheme <- CookieAuthenticationDefaults.AuthenticationScheme
opts.DefaultSignInScheme <- CookieAuthenticationDefaults.AuthenticationScheme
opts.DefaultChallengeScheme <- CookieAuthenticationDefaults.AuthenticationScheme)
.AddCookie()
.AddOpenIdConnect("Auth0", fun opts ->
// Configure OIDC with Auth0 options from configuration
let cfg = bldr.Configuration.GetSection "Auth0"
opts.Authority <- $"""https://{cfg["Domain"]}/"""
opts.ClientId <- cfg["Id"]
opts.ClientSecret <- cfg["Secret"]
opts.ResponseType <- OpenIdConnectResponseType.Code
opts.CallbackPath <- PathString "/user/log-on/success" opts.Scope.Clear ()
opts.ClaimsIssuer <- "Auth0" opts.Scope.Add "openid"
opts.SaveTokens <- true opts.Scope.Add "profile"
opts.Events <- OpenIdConnectEvents () opts.CallbackPath <- PathString "/user/log-on/success"
opts.Events.OnRedirectToIdentityProviderForSignOut <- fun ctx -> opts.ClaimsIssuer <- "Auth0"
let returnTo = opts.SaveTokens <- true
match ctx.Properties.RedirectUri with
| it when isNull it || it = "" -> ""
| redirUri ->
let finalRedirUri =
match redirUri.StartsWith "/" with
| true ->
// transform to absolute
let request = ctx.Request
sprintf "%s://%s%s%s" request.Scheme request.Host.Value request.PathBase.Value redirUri
| false -> redirUri
Uri.EscapeDataString finalRedirUri |> sprintf "&returnTo=%s"
sprintf "https://%s/v2/logout?client_id=%s%s" cfg["Domain"] cfg["Id"] returnTo
|> ctx.Response.Redirect
ctx.HandleResponse ()
Task.CompletedTask opts.Events <- OpenIdConnectEvents ()
opts.Events.OnRedirectToIdentityProvider <- fun ctx -> opts.Events.OnRedirectToIdentityProviderForSignOut <- fun ctx ->
let bldr = UriBuilder ctx.ProtocolMessage.RedirectUri let returnTo =
bldr.Scheme <- cfg["Scheme"] match ctx.Properties.RedirectUri with
bldr.Port <- int cfg["Port"] | it when isNull it || it = "" -> ""
ctx.ProtocolMessage.RedirectUri <- string bldr | redirUri ->
Task.CompletedTask let finalRedirUri =
) match redirUri.StartsWith "/" with
|> ignore | true ->
let jsonOptions = JsonSerializerOptions () // transform to absolute
jsonOptions.Converters.Add (JsonFSharpConverter ()) let request = ctx.Request
let db = new LiteDatabase (bldr.Configuration.GetConnectionString "db") $"{request.Scheme}://{request.Host.Value}{request.PathBase.Value}{redirUri}"
Data.Startup.ensureDb db | false -> redirUri
bldr.Services.AddSingleton(jsonOptions) Uri.EscapeDataString $"&returnTo={finalRedirUri}"
.AddSingleton<Json.ISerializer, SystemTextJson.Serializer>() ctx.Response.Redirect $"""https://{cfg["Domain"]}/v2/logout?client_id={cfg["Id"]}{returnTo}"""
.AddSingleton<LiteDatabase> db ctx.HandleResponse ()
|> ignore Task.CompletedTask
bldr.Build () opts.Events.OnRedirectToIdentityProvider <- fun ctx ->
let bldr = UriBuilder ctx.ProtocolMessage.RedirectUri
bldr.Scheme <- cfg["Scheme"]
bldr.Port <- int cfg["Port"]
ctx.ProtocolMessage.RedirectUri <- string bldr
Task.CompletedTask)
let jsonOptions = JsonSerializerOptions ()
jsonOptions.Converters.Add (JsonFSharpConverter ())
let db = new LiteDatabase (bldr.Configuration.GetConnectionString "db")
Data.Startup.ensureDb db
let _ = bldr.Services.AddSingleton jsonOptions
let _ = bldr.Services.AddSingleton<Json.ISerializer, SystemTextJson.Serializer> ()
let _ = bldr.Services.AddSingleton<LiteDatabase> db
bldr.Build ()
open Giraffe.EndpointRouting open Giraffe.EndpointRouting
/// Configure the web application /// Configure the web application
let application (app : WebApplication) = let application (app : WebApplication) =
// match app.Environment.IsDevelopment () with let _ = app.UseStaticFiles ()
// | true -> app.UseDeveloperExceptionPage () let _ = app.UseCookiePolicy ()
// | false -> app.UseGiraffeErrorHandler Handlers.Error.error let _ = app.UseRouting ()
// |> ignore let _ = app.UseAuthentication ()
app let _ = app.UseGiraffeErrorHandler Handlers.Error.error
.UseStaticFiles() let _ = app.UseEndpoints (fun e -> e.MapGiraffeEndpoints Handlers.routes)
.UseCookiePolicy() app
.UseRouting()
.UseAuthentication()
.UseGiraffeErrorHandler(Handlers.Error.error)
.UseEndpoints (fun e -> e.MapGiraffeEndpoints Handlers.routes |> ignore)
|> ignore
app
/// Compose all the configurations into one /// Compose all the configurations into one
let webHost pathSegments = let webHost pathSegments =
contentRoot contentRoot
>> appConfiguration >> appConfiguration
>> kestrel >> kestrel
>> webRoot pathSegments >> webRoot pathSegments
>> logging >> logging
>> services >> services
>> application >> application
[<EntryPoint>] [<EntryPoint>]
let main _ = let main _ =
use host = Configure.webHost [| "wwwroot" |] (Directory.GetCurrentDirectory ()) use host = Configure.webHost [| "wwwroot" |] (Directory.GetCurrentDirectory ())
host.Run () host.Run ()
0 0

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

@ -2,6 +2,7 @@
[<AutoOpen>] [<AutoOpen>]
module private MyPrayerJournal.Views.Helpers module private MyPrayerJournal.Views.Helpers
open Giraffe.Htmx
open Giraffe.ViewEngine open Giraffe.ViewEngine
open Giraffe.ViewEngine.Htmx open Giraffe.ViewEngine.Htmx
open MyPrayerJournal open MyPrayerJournal
@ -9,23 +10,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 "true" ]
|> 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 (tz : DateTimeZone) =
span [ _title (date.ToDateTimeOffset().ToString ("f", null)) ] [ Dates.formatDistance now date |> str ] span [ _title (date.InZone(tz).ToDateTimeOffset().ToString ("f", null)) ] [ Dates.formatDistance now date |> str ]

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

@ -1,177 +1,180 @@
/// Views for journal pages and components /// Views for journal pages and components
module MyPrayerJournal.Views.Journal module MyPrayerJournal.Views.Journal
open Giraffe.Htmx
open Giraffe.ViewEngine open Giraffe.ViewEngine
open Giraffe.ViewEngine.Accessibility open Giraffe.ViewEngine.Accessibility
open Giraffe.ViewEngine.Htmx open Giraffe.ViewEngine.Htmx
open MyPrayerJournal open MyPrayerJournal
/// Display a card for this prayer request /// Display a card for this prayer request
let journalCard now req = let journalCard now tz 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 [] [
match req.LastPrayed with
| Some dt -> str "last prayed "; relativeDate dt now tz
| None -> str "last activity "; relativeDate req.AsOf now tz
]
]
] ]
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 tz 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 tz)
|> 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 _ariaLabel "Prayer Requests" ]
]
/// 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" ] ]
] ]

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

@ -1,151 +1,148 @@
/// Layout / home views /// Layout / home views
module MyPrayerJournal.Views.Layout module MyPrayerJournal.Views.Layout
// fsharplint:disable RecordFieldNames
open Giraffe.ViewEngine 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.2.0/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-gH2yIJqKdNHPEq0n4Mqa/HGKIhSkIHeL5AyhkYV8i59U5AR6csBvApHHNl/vI1Bx"
_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.1"
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
script [ script [] [
_src "https://unpkg.com/htmx.org@1.5.0" rawText "if (!htmx) document.write('<script src=\"/script/htmx.min.js\"><\/script>')"
_integrity "sha384-oGA+prIp5Vchu6we2YkI51UtVzN9Jpx2Z7PnR1I78PnZlN8LkrCT4lqqqmDkyrvI" ]
_crossorigin "anonymous" script [ _async
] [] _src "https://cdn.jsdelivr.net/npm/bootstrap@5.2.0/dist/js/bootstrap.bundle.min.js"
script [] [ _integrity "sha384-A3rJD856KowSb7dwlZdYEkO39Gagi7vIsF0jrRAoQmDKKtQBHUuLZ9AsSv4jD4Xa"
rawText "if (!htmx) document.write('<script src=\"/script/htmx-1.5.0.min.js\"><\/script>')" _crossorigin "anonymous" ] []
] script [] [
script [ rawText "setTimeout(function () { "
_async rawText "if (!bootstrap) document.write('<script src=\"/script/bootstrap.bundle.min.js\"><\/script>') "
_src "https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/js/bootstrap.bundle.min.js" rawText "}, 2000)"
_integrity "sha384-MrcW6ZMFYlzcLA8Nl+NtUVF0sA7MsXsP1UyJoMp4YLEuNSfAP+JcXn/tWtIaxVXM" ]
_crossorigin "anonymous" script [ _src "/script/mpj.js" ] []
] []
script [] [
rawText "setTimeout(function () { "
rawText "if (!bootstrap) document.write('<script src=\"/script/bootstrap.bundle.min.js\"><\/script>') "
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."
]
]

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

@ -1,268 +1,270 @@
/// Views for request pages and components /// Views for request pages and components
module MyPrayerJournal.Views.Request module MyPrayerJournal.Views.Request
open Giraffe.Htmx
open Giraffe.ViewEngine open Giraffe.ViewEngine
open Giraffe.ViewEngine.Htmx open Giraffe.ViewEngine.Htmx
open MyPrayerJournal open MyPrayerJournal
open NodaTime open NodaTime
open System
/// Create a request within the list /// Create a request within the list
let reqListItem now req = let reqListItem now tz req =
let reqId = RequestId.toString req.requestId let isFuture instant = defaultArg (instant |> Option.map (fun it -> it > now)) false
let isAnswered = req.lastStatus = Answered let reqId = RequestId.toString req.RequestId
let isSnoozed = req.snoozedUntil > now let isAnswered = req.LastStatus = Answered
let isPending = (not isSnoozed) && req.showAfter > now let isSnoozed = isFuture req.SnoozedUntil
let btnClass = _class "btn btn-light mx-2" let isPending = (not isSnoozed) && isFuture req.ShowAfter
let restoreBtn (link : string) title = let btnClass = _class "btn btn-light mx-2"
button [ btnClass; _hxPatch $"/request/{reqId}/{link}"; _title title ] [ icon "restore" ] let restoreBtn (link : string) title =
div [ _class "list-group-item px-0 d-flex flex-row align-items-start"; _hxTarget "this"; _hxSwap HxSwap.OuterHtml ] [ button [ btnClass; _hxPatch $"/request/{reqId}/{link}"; _title title ] [ icon "restore" ]
pageLink $"/request/{reqId}/full" [ btnClass; _title "View Full Request" ] [ icon "description" ] div [ _class "list-group-item px-0 d-flex flex-row align-items-start"
match isAnswered with _hxTarget "this"
| true -> () _hxSwap HxSwap.OuterHtml ] [
| false -> pageLink $"/request/{reqId}/edit" [ btnClass; _title "Edit Request" ] [ icon "edit" ] pageLink $"/request/{reqId}/full" [ btnClass; _title "View Full Request" ] [ icon "description" ]
match true with if not isAnswered then pageLink $"/request/{reqId}/edit" [ btnClass; _title "Edit Request" ] [ icon "edit" ]
| _ when isSnoozed -> restoreBtn "cancel-snooze" "Cancel Snooze" if isSnoozed then restoreBtn "cancel-snooze" "Cancel Snooze"
| _ when isPending -> restoreBtn "show" "Show Now" elif isPending then restoreBtn "show" "Show Now"
| _ -> () p [ _class "request-text mb-0" ] [
p [ _class "request-text mb-0" ] [ str req.Text
str req.text if isSnoozed || isPending || isAnswered then
match isSnoozed || isPending || isAnswered with br []
| true -> small [ _class "text-muted" ] [
br [] if isSnoozed then [ str "Snooze expires "; relativeDate req.SnoozedUntil.Value now tz ]
small [ _class "text-muted" ] [ elif isPending then [ str "Request appears next "; relativeDate req.ShowAfter.Value now tz ]
match () with else (* isAnswered *) [ str "Answered "; relativeDate req.AsOf now tz ]
| _ when isSnoozed -> [ str "Snooze expires "; relativeDate req.snoozedUntil now ] |> em []
| _ 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 tz reqs =
reqs reqs
|> List.map (reqListItem now) |> List.map (reqListItem now tz)
|> 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 tz 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 tz reqs
] ]
/// View for Answered Requests page /// View for Answered Requests page
let answered now reqs = article [ _class "container mt-3" ] [ let answered now tz 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 Answered 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 tz reqs
] ]
/// View for Snoozed Requests page /// View for Snoozed Requests page
let snoozed now reqs = article [ _class "container mt-3" ] [ let snoozed now tz 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 tz reqs
]
/// View for Full Request page /// View for Full Request page
let full (clock : IClock) (req : Request) = let full (clock : IClock) tz (req : Request) =
let now = clock.GetCurrentInstant () let now = clock.GetCurrentInstant ()
let answered = let answered =
req.history req.History
|> List.filter RequestAction.isAnswered |> Array.filter History.isAnswered
|> List.tryHead |> Array.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 |> Array.filter History.isPrayed |> Array.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 |> Array.filter History.isCreated |> Array.head).AsOf).TotalDays |> int).ToString "N0"
let lastText = let lastText =
req.history req.History
|> List.filter (fun h -> Option.isSome h.text) |> Array.filter (fun h -> Option.isSome h.Text)
|> List.sortByDescending (fun h -> h.asOf) |> Array.sortByDescending (fun h -> h.AsOf)
|> List.map (fun h -> Option.get h.text) |> Array.map (fun h -> Option.get h.Text)
|> List.head |> Array.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" |}) |> Array.map (fun n -> {| asOf = n.AsOf; text = Some n.Notes; status = "Notes" |})
|> List.append (req.history |> List.map toDisp) |> Array.append (req.History |> Array.map toDisp)
|> List.sortByDescending (fun it -> it.asOf) |> Array.sortByDescending (fun it -> it.asOf)
// Skip the first entry for answered requests; that info is already displayed |> List.ofArray
match answered with Some _ -> all |> List.skip 1 | None -> all // Skip the first entry for answered requests; that info is already displayed
article [ _class "container mt-3" ] [ match answered with Some _ -> all.Tail | None -> all
div [_class "card" ] [ article [ _class "container mt-3" ] [
h5 [ _class "card-header" ] [ str "Full Prayer Request" ] div [_class "card" ] [
div [ _class "card-body" ] [ h5 [ _class "card-header" ] [ str "Full Prayer Request" ]
h6 [ _class "card-subtitle text-muted mb-2"] [ div [ _class "card-body" ] [
match answered with h6 [ _class "card-subtitle text-muted mb-2"] [
| Some date -> match answered with
str "Answered " | Some date ->
date.ToDateTimeOffset().ToString ("D", null) |> str str "Answered "
str " (" date.ToDateTimeOffset().ToString ("D", null) |> str
relativeDate date now str " ("
rawText ") &bull; " relativeDate date now tz
| None -> () rawText ") &bull; "
sprintf "Prayed %s times &bull; Open %s days" prayed daysOpen |> rawText | None -> ()
] rawText $"Prayed %s{prayed} times &bull; Open %s{daysOpen} days"
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"
article [ _class "container" ] [ let recurCount =
h2 [ _class "pb-3" ] [ (match isNew with true -> "Add" | false -> "Edit") |> strf "%s Prayer Request" ] match req.Recurrence with
form [ | Immediate -> None
_hxBoost | Hours h -> Some h
_hxTarget "#top" | Days d -> Some d
_hxPushUrl | Weeks w -> Some w
"/request" |> match isNew with true -> _hxPost | false -> _hxPatch |> Option.map string
] [ |> Option.defaultValue ""
input [ article [ _class "container" ] [
_type "hidden" h2 [ _class "pb-3" ] [ (match isNew with true -> "Add" | false -> "Edit") |> strf "%s Prayer Request" ]
_name "requestId" form [ _hxBoost
_value (match isNew with true -> "new" | false -> RequestId.toString req.requestId) _hxTarget "#top"
] _hxPushUrl "true"
input [ _type "hidden"; _name "returnTo"; _value returnTo ] "/request" |> match isNew with true -> _hxPost | false -> _hxPatch ] [
div [ _class "form-floating pb-3" ] [ input [ _type "hidden"
textarea [ _name "requestId"
_id "requestText" _value (match isNew with true -> "new" | false -> RequestId.toString req.RequestId) ]
_name "requestText" input [ _type "hidden"; _name "returnTo"; _value returnTo ]
_class "form-control" div [ _class "form-floating pb-3" ] [
_style "min-height: 8rem;" textarea [ _id "requestText"
_placeholder "Enter the text of the request" _name "requestText"
_autofocus; _required _class "form-control"
] [ str req.text ] _style "min-height: 8rem;"
label [ _for "requestText" ] [ str "Prayer Request" ] _placeholder "Enter the text of the request"
] _autofocus; _required ] [ str req.Text ]
br [] label [ _for "requestText" ] [ str "Prayer Request" ]
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.recurType 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.recurType 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 (string req.recurCount)
_style "width:6rem;"
_required
match req.recurType 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.recurType with Immediate -> _disabled | _ -> ()
] [
option [ _value "Hours"; match req.recurType with Hours -> _selected | _ -> () ] [ str "hours" ]
option [ _value "Days"; match req.recurType with Days -> _selected | _ -> () ] [ str "days" ]
option [ _value "Weeks"; match req.recurType 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 tz 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 tz ]; 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
] ]

6
src/MyPrayerJournal/wwwroot/script/bootstrap.bundle.min.js vendored
View File

File diff suppressed because one or more lines are too long

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

File diff suppressed because one or more lines are too long

65
src/MyPrayerJournal/wwwroot/script/htmx.min.js vendored Normal file
View File

File diff suppressed because one or more lines are too long

24
src/MyPrayerJournal/wwwroot/script/mpj.js
View File

@ -1,7 +1,7 @@
"use strict" "use strict"
/** myPrayerJournal script */ /** myPrayerJournal script */
const mpj = { this.mpj = {
/** /**
* Show a message via toast * Show a message via toast
* @param {string} message The message to show * @param {string} message The message to show
@ -66,6 +66,19 @@ const mpj = {
const isDisabled = target.value === "Immediate" const isDisabled = target.value === "Immediate"
;["recurCount", "recurInterval"].forEach(it => document.getElementById(it).disabled = isDisabled) ;["recurCount", "recurInterval"].forEach(it => document.getElementById(it).disabled = isDisabled)
} }
},
/**
* The time zone of the current browser
* @type {string}
**/
timeZone: undefined,
/**
* Derive the time zone from the current browser
*/
deriveTimeZone () {
try {
this.timeZone = (new Intl.DateTimeFormat()).resolvedOptions().timeZone
} catch (_) { }
} }
} }
@ -80,3 +93,12 @@ htmx.on("htmx:afterOnLoad", function (evt) {
document.getElementById(evt.detail.xhr.getResponseHeader("x-hide-modal") + "Dismiss").click() document.getElementById(evt.detail.xhr.getResponseHeader("x-hide-modal") + "Dismiss").click()
} }
}) })
htmx.on("htmx:configRequest", function (evt) {
// Send the user's current time zone so that we can display local time
if (mpj.timeZone) {
evt.detail.headers["X-Time-Zone"] = mpj.timeZone
}
})
mpj.deriveTimeZone()

8
src/MyPrayerJournal/wwwroot/style/bootstrap.min.css vendored
View File

File diff suppressed because one or more lines are too long