diff --git a/src/MyPrayerJournal.ToPostgres/LiteData.fs b/src/MyPrayerJournal.ToPostgres/LiteData.fs new file mode 100644 index 0000000..c7277b2 --- /dev/null +++ b/src/MyPrayerJournal.ToPostgres/LiteData.fs @@ -0,0 +1,106 @@ +module MyPrayerJournal.LiteData + +open LiteDB +open MyPrayerJournal +open NodaTime + +/// Request is the identifying record for a prayer request +[] +type OldRequest = + { /// The ID of the request + Id : RequestId + + /// The time this request was initially entered + EnteredOn : Instant + + /// The ID of the user to whom this request belongs ("sub" from the JWT) + UserId : UserId + + /// The time at which this request should reappear in the user's journal by manual user choice + SnoozedUntil : Instant option + + /// The time at which this request should reappear in the user's journal by recurrence + ShowAfter : Instant option + + /// The recurrence for this request + Recurrence : Recurrence + + /// The history entries for this request + History : History[] + + /// The notes for this request + Notes : Note[] + } + + +/// LiteDB extensions +[] +module Extensions = + + /// Extensions on the LiteDatabase class + type LiteDatabase with + + /// The Request collection + member this.Requests = this.GetCollection "request" + + +/// Map domain to LiteDB +// It does mapping, but since we're so DU-heavy, this gives us control over the JSON representation +[] +module Mapping = + + open NodaTime.Text + + /// A NodaTime instant pattern to use for parsing instants from the database + let instantPattern = InstantPattern.CreateWithInvariantCulture "g" + + /// Mapping for NodaTime's Instant type + module Instant = + let fromBson (value : BsonValue) = (instantPattern.Parse value.AsString).Value + let toBson (value : Instant) : BsonValue = value.ToString ("g", null) + + /// Mapping for option types + module Option = + let instantFromBson (value : BsonValue) = if value.IsNull then None else Some (Instant.fromBson value) + let instantToBson (value : Instant option) = match value with Some it -> Instant.toBson it | None -> null + + let stringFromBson (value : BsonValue) = match value.AsString with "" -> None | x -> Some x + let stringToBson (value : string option) : BsonValue = match value with Some txt -> txt | None -> "" + + /// Mapping for Recurrence + module Recurrence = + let fromBson (value : BsonValue) = Recurrence.ofString value + let toBson (value : Recurrence) : BsonValue = Recurrence.toString value + + /// Mapping for RequestAction + module RequestAction = + let fromBson (value : BsonValue) = RequestAction.ofString value.AsString + let toBson (value : RequestAction) : BsonValue = RequestAction.toString value + + /// Mapping for RequestId + module RequestId = + let fromBson (value : BsonValue) = RequestId.ofString value.AsString + let toBson (value : RequestId) : BsonValue = RequestId.toString value + + /// Mapping for UserId + module UserId = + let fromBson (value : BsonValue) = UserId value.AsString + let toBson (value : UserId) : BsonValue = UserId.toString value + + /// Set up the mapping + let register () = + BsonMapper.Global.RegisterType(Instant.toBson, Instant.fromBson) + BsonMapper.Global.RegisterType(Option.instantToBson, Option.instantFromBson) + BsonMapper.Global.RegisterType(Recurrence.toBson, Recurrence.fromBson) + BsonMapper.Global.RegisterType(RequestAction.toBson, RequestAction.fromBson) + BsonMapper.Global.RegisterType(RequestId.toBson, RequestId.fromBson) + BsonMapper.Global.RegisterType(Option.stringToBson, Option.stringFromBson) + BsonMapper.Global.RegisterType(UserId.toBson, UserId.fromBson) + +/// Code to be run at startup +module Startup = + + /// Ensure the database is set up + let ensureDb (db : LiteDatabase) = + db.Requests.EnsureIndex (fun it -> it.UserId) |> ignore + Mapping.register () diff --git a/src/MyPrayerJournal.ToPostgres/MyPrayerJournal.ToPostgres.fsproj b/src/MyPrayerJournal.ToPostgres/MyPrayerJournal.ToPostgres.fsproj index 7913b82..018a50c 100644 --- a/src/MyPrayerJournal.ToPostgres/MyPrayerJournal.ToPostgres.fsproj +++ b/src/MyPrayerJournal.ToPostgres/MyPrayerJournal.ToPostgres.fsproj @@ -3,9 +3,11 @@ Exe net7.0 + 3391 + @@ -13,4 +15,9 @@ + + + + + diff --git a/src/MyPrayerJournal.ToPostgres/Program.fs b/src/MyPrayerJournal.ToPostgres/Program.fs index d6818ab..d1b4ad3 100644 --- a/src/MyPrayerJournal.ToPostgres/Program.fs +++ b/src/MyPrayerJournal.ToPostgres/Program.fs @@ -1,2 +1,9 @@ -// For more information see https://aka.ms/fsharp-console-apps -printfn "Hello from F#" +open LiteDB +open MyPrayerJournal.Domain +open MyPrayerJournal.LiteData + + +let lite = new LiteDatabase "Filename=./mpj.db" +Startup.ensureDb lite + + diff --git a/src/MyPrayerJournal.sln b/src/MyPrayerJournal.sln index 393866a..fdc0553 100644 --- a/src/MyPrayerJournal.sln +++ b/src/MyPrayerJournal.sln @@ -5,7 +5,7 @@ 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}" +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "MyPrayerJournal.ToPostgres", "MyPrayerJournal.ToPostgres\MyPrayerJournal.ToPostgres.fsproj", "{3114B8F4-E388-4804-94D3-A2F4D42797C6}" EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution @@ -24,5 +24,9 @@ Global {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 + {3114B8F4-E388-4804-94D3-A2F4D42797C6}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {3114B8F4-E388-4804-94D3-A2F4D42797C6}.Debug|Any CPU.Build.0 = Debug|Any CPU + {3114B8F4-E388-4804-94D3-A2F4D42797C6}.Release|Any CPU.ActiveCfg = Release|Any CPU + {3114B8F4-E388-4804-94D3-A2F4D42797C6}.Release|Any CPU.Build.0 = Release|Any CPU EndGlobalSection EndGlobal diff --git a/src/MyPrayerJournal/Data.fs b/src/MyPrayerJournal/Data.fs index 6380765..a8102a3 100644 --- a/src/MyPrayerJournal/Data.fs +++ b/src/MyPrayerJournal/Data.fs @@ -97,7 +97,7 @@ module Request = /// Retrieve a request by its ID and user ID (excludes history and notes) let tryById reqId userId = backgroundTask { match! tryByIdFull reqId userId with - | Some req -> return Some { req with History = [||]; Notes = [||] } + | Some req -> return Some { req with History = []; Notes = [] } | None -> return None } @@ -134,7 +134,9 @@ module History = let add reqId userId hist = backgroundTask { let dbId = RequestId.toString reqId match! Request.tryByIdFull reqId userId with - | Some req -> do! Update.partialById Table.Request dbId {| History = Array.append [| hist |] req.History |} + | Some req -> + do! Update.partialById Table.Request dbId + {| History = (hist :: req.History) |> List.sortByDescending (fun it -> it.AsOf) |} | None -> invalidOp $"Request ID {dbId} not found" } @@ -189,11 +191,13 @@ module Note = let add reqId userId note = backgroundTask { let dbId = RequestId.toString reqId match! Request.tryByIdFull reqId userId with - | Some req -> do! Update.partialById Table.Request dbId {| Notes = Array.append [| note |] req.Notes |} + | Some req -> + do! Update.partialById Table.Request dbId + {| Notes = (note :: req.Notes) |> List.sortByDescending (fun it -> it.AsOf) |} | None -> invalidOp $"Request ID {dbId} not found" } /// Retrieve notes for a request by the request ID let byRequestId reqId userId = backgroundTask { - match! Request.tryByIdFull reqId userId with Some req -> return req.Notes | None -> return [||] + match! Request.tryByIdFull reqId userId with Some req -> return req.Notes | None -> return [] } diff --git a/src/MyPrayerJournal/Domain.fs b/src/MyPrayerJournal/Domain.fs index 4201135..2389ce0 100644 --- a/src/MyPrayerJournal/Domain.fs +++ b/src/MyPrayerJournal/Domain.fs @@ -169,10 +169,10 @@ type Request = Recurrence : Recurrence /// The history entries for this request - History : History[] + History : History list /// The notes for this request - Notes : Note[] + Notes : Note list } /// Functions to support requests @@ -186,8 +186,8 @@ module Request = SnoozedUntil = None ShowAfter = None Recurrence = Immediate - History = [||] - Notes = [||] + History = [] + Notes = [] } @@ -234,7 +234,8 @@ module JournalRequest = /// Convert a request to the form used for the journal (precomputed values, no notes or history) let ofRequestLite (req : Request) = - let lastHistory = req.History |> Array.sortByDescending (fun it -> it.AsOf) |> Array.tryHead + let history = Seq.ofList req.History + let lastHistory = Seq.tryHead history // Requests are sorted by the "as of" field in this record; for sorting to work properly, we will put the // largest of the last prayed date, the "snoozed until". or the "show after" date; if none of those are filled, // we will use the last activity date. This will mean that: @@ -247,19 +248,17 @@ module JournalRequest = let showAfter = defaultArg req.ShowAfter Instant.MinValue let snoozedUntil = defaultArg req.SnoozedUntil Instant.MinValue let lastPrayed = - req.History - |> Array.sortByDescending (fun it -> it.AsOf) - |> Array.filter History.isPrayed - |> Array.tryHead + history + |> Seq.filter History.isPrayed + |> Seq.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 + Text = history + |> Seq.filter (fun it -> Option.isSome it.Text) + |> Seq.tryHead |> Option.map (fun h -> Option.get h.Text) |> Option.defaultValue "" AsOf = if asOf > Instant.MinValue then asOf else lastActivity @@ -275,6 +274,6 @@ module JournalRequest = /// Same as `ofRequestLite`, but with notes and history let ofRequestFull req = { ofRequestLite req with - History = List.ofArray req.History - Notes = List.ofArray req.Notes + History = req.History + Notes = req.Notes } diff --git a/src/MyPrayerJournal/Handlers.fs b/src/MyPrayerJournal/Handlers.fs index c81f837..d071877 100644 --- a/src/MyPrayerJournal/Handlers.fs +++ b/src/MyPrayerJournal/Handlers.fs @@ -270,7 +270,7 @@ module Components = // GET /components/request/[req-id]/notes let notes requestId : HttpHandler = requireUser >=> fun next ctx -> task { let! notes = Note.byRequestId (RequestId.ofString requestId) ctx.UserId - return! renderComponent (Views.Request.notes (ctx.Now ()) ctx.TimeZone (List.ofArray notes)) next ctx + return! renderComponent (Views.Request.notes (ctx.Now ()) ctx.TimeZone notes) next ctx } // GET /components/request/[req-id]/snooze @@ -454,12 +454,12 @@ module Request = EnteredOn = now ShowAfter = None Recurrence = parseRecurrence form - History = [| + History = [ { AsOf = now Status = Created Text = Some form.requestText } - |] + ] } do! Request.add req Messages.pushSuccess ctx "Added prayer request" "/journal" diff --git a/src/MyPrayerJournal/LiteData.fs b/src/MyPrayerJournal/LiteData.fs deleted file mode 100644 index b930f3f..0000000 --- a/src/MyPrayerJournal/LiteData.fs +++ /dev/null @@ -1,199 +0,0 @@ -module MyPrayerJournal.LiteData - -open LiteDB -open MyPrayerJournal -open System.Threading.Tasks - -/// LiteDB extensions -[] -module Extensions = - - /// Extensions on the LiteDatabase class - type LiteDatabase with - - /// The Request collection - member this.Requests = this.GetCollection "request" - - /// Async version of the checkpoint command (flushes log) - member this.SaveChanges () = - this.Checkpoint () - Task.CompletedTask - - -/// Map domain to LiteDB -// It does mapping, but since we're so DU-heavy, this gives us control over the JSON representation -[] -module Mapping = - - open NodaTime - open NodaTime.Text - - /// A NodaTime instant pattern to use for parsing instants from the database - let instantPattern = InstantPattern.CreateWithInvariantCulture "g" - - /// Mapping for NodaTime's Instant type - module Instant = - let fromBson (value : BsonValue) = (instantPattern.Parse value.AsString).Value - let toBson (value : Instant) : BsonValue = value.ToString ("g", null) - - /// Mapping for option types - module Option = - let instantFromBson (value : BsonValue) = if value.IsNull then None else Some (Instant.fromBson value) - let instantToBson (value : Instant option) = match value with Some it -> Instant.toBson it | None -> null - - let stringFromBson (value : BsonValue) = match value.AsString with "" -> None | x -> Some x - let stringToBson (value : string option) : BsonValue = match value with Some txt -> txt | None -> "" - - /// Mapping for Recurrence - module Recurrence = - let fromBson (value : BsonValue) = Recurrence.ofString value - let toBson (value : Recurrence) : BsonValue = Recurrence.toString value - - /// Mapping for RequestAction - module RequestAction = - let fromBson (value : BsonValue) = RequestAction.ofString value.AsString - let toBson (value : RequestAction) : BsonValue = RequestAction.toString value - - /// Mapping for RequestId - module RequestId = - let fromBson (value : BsonValue) = RequestId.ofString value.AsString - let toBson (value : RequestId) : BsonValue = RequestId.toString value - - /// Mapping for UserId - module UserId = - let fromBson (value : BsonValue) = UserId value.AsString - let toBson (value : UserId) : BsonValue = UserId.toString value - - /// Set up the mapping - let register () = - BsonMapper.Global.RegisterType(Instant.toBson, Instant.fromBson) - BsonMapper.Global.RegisterType(Option.instantToBson, Option.instantFromBson) - BsonMapper.Global.RegisterType(Recurrence.toBson, Recurrence.fromBson) - BsonMapper.Global.RegisterType(RequestAction.toBson, RequestAction.fromBson) - BsonMapper.Global.RegisterType(RequestId.toBson, RequestId.fromBson) - BsonMapper.Global.RegisterType(Option.stringToBson, Option.stringFromBson) - BsonMapper.Global.RegisterType(UserId.toBson, UserId.fromBson) - -/// Code to be run at startup -module Startup = - - /// Ensure the database is set up - let ensureDb (db : LiteDatabase) = - db.Requests.EnsureIndex (fun it -> it.UserId) |> ignore - Mapping.register () - - -/// Async wrappers for LiteDB, and request -> journal mappings -[] -module private Helpers = - - open System.Linq - - /// Convert a sequence to a list asynchronously (used for LiteDB IO) - let toListAsync<'T> (q : 'T seq) = - (q.ToList >> Task.FromResult) () - - /// Convert a sequence to a list asynchronously (used for LiteDB IO) - let firstAsync<'T> (q : 'T seq) = - q.FirstOrDefault () |> Task.FromResult - - /// Async wrapper around a request update - let doUpdate (db : LiteDatabase) (req : Request) = - db.Requests.Update req |> ignore - Task.CompletedTask - - -/// Retrieve a request, including its history and notes, by its ID and user ID -let tryFullRequestById reqId userId (db : LiteDatabase) = backgroundTask { - let! req = db.Requests.Find (Query.EQ ("_id", RequestId.toString reqId)) |> firstAsync - return match box req with null -> None | _ when req.UserId = userId -> Some req | _ -> None -} - -/// Add a history entry -let addHistory reqId userId hist db = backgroundTask { - match! tryFullRequestById reqId userId db with - | Some req -> do! doUpdate db { req with History = Array.append [| hist |] req.History } - | None -> invalidOp $"{RequestId.toString reqId} not found" -} - -/// Add a note -let addNote reqId userId note db = backgroundTask { - match! tryFullRequestById reqId userId db with - | Some req -> do! doUpdate db { req with Notes = Array.append [| note |] req.Notes } - | None -> invalidOp $"{RequestId.toString reqId} not found" -} - -/// Add a request -let addRequest (req : Request) (db : LiteDatabase) = - db.Requests.Insert req |> ignore - -/// 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 -let answeredRequests userId db = backgroundTask { - let! reqs = getRequestsForUser userId db - return - reqs - |> Seq.map JournalRequest.ofRequestFull - |> Seq.filter (fun it -> it.LastStatus = Answered) - |> Seq.sortByDescending (fun it -> it.AsOf) - |> List.ofSeq -} - -/// Retrieve the user's current journal -let journalByUserId userId db = backgroundTask { - let! reqs = getRequestsForUser userId db - return - reqs - |> Seq.map JournalRequest.ofRequestLite - |> Seq.filter (fun it -> it.LastStatus <> Answered) - |> Seq.sortBy (fun it -> it.AsOf) - |> List.ofSeq -} - -/// Does the user have any snoozed requests? -let hasSnoozed userId now (db : LiteDatabase) = backgroundTask { - let! jrnl = journalByUserId userId db - return jrnl |> List.exists (fun r -> defaultArg (r.SnoozedUntil |> Option.map (fun it -> it > now)) false) -} - -/// Retrieve a request by its ID and user ID (without notes and history) -let tryRequestById reqId userId db = backgroundTask { - let! req = tryFullRequestById reqId userId db - return req |> Option.map (fun r -> { r with History = [||]; Notes = [||] }) -} - -/// Retrieve notes for a request by its ID and user ID -let notesById reqId userId (db : LiteDatabase) = backgroundTask { - match! tryFullRequestById reqId userId db with | Some req -> return req.Notes | None -> return [||] -} - -/// Retrieve a journal request by its ID and user ID -let tryJournalById reqId userId (db : LiteDatabase) = backgroundTask { - let! req = tryFullRequestById reqId userId db - return req |> Option.map JournalRequest.ofRequestLite -} - -/// Update the recurrence for a request -let updateRecurrence reqId userId recurType db = backgroundTask { - match! tryFullRequestById reqId userId db with - | Some req -> do! doUpdate db { req with Recurrence = recurType } - | None -> invalidOp $"{RequestId.toString reqId} not found" -} - -/// Update a snoozed request -let updateSnoozed reqId userId until db = backgroundTask { - match! tryFullRequestById reqId userId db with - | Some req -> do! doUpdate db { req with SnoozedUntil = until; ShowAfter = until } - | None -> invalidOp $"{RequestId.toString reqId} not found" -} - -/// Update the "show after" timestamp for a request -let updateShowAfter reqId userId showAfter db = backgroundTask { - match! tryFullRequestById reqId userId db with - | Some req -> do! doUpdate db { req with ShowAfter = showAfter } - | None -> invalidOp $"{RequestId.toString reqId} not found" -} diff --git a/src/MyPrayerJournal/MyPrayerJournal.fsproj b/src/MyPrayerJournal/MyPrayerJournal.fsproj index 20289fa..2ffa9ec 100644 --- a/src/MyPrayerJournal/MyPrayerJournal.fsproj +++ b/src/MyPrayerJournal/MyPrayerJournal.fsproj @@ -1,14 +1,12 @@  net7.0 - 3.2 + 3.3 embedded false - 3391 - @@ -26,7 +24,6 @@ - diff --git a/src/MyPrayerJournal/Views/Request.fs b/src/MyPrayerJournal/Views/Request.fs index 8549e46..e465f28 100644 --- a/src/MyPrayerJournal/Views/Request.fs +++ b/src/MyPrayerJournal/Views/Request.fs @@ -77,28 +77,31 @@ let full (clock : IClock) tz (req : Request) = let now = clock.GetCurrentInstant () let answered = req.History - |> Array.filter History.isAnswered - |> Array.tryHead + |> Seq.ofList + |> Seq.filter History.isAnswered + |> Seq.tryHead |> Option.map (fun x -> x.AsOf) - let prayed = (req.History |> Array.filter History.isPrayed |> Array.length).ToString "N0" + let prayed = (req.History |> List.filter History.isPrayed |> List.length).ToString "N0" let daysOpen = let asOf = defaultArg answered now - ((asOf - (req.History |> Array.filter History.isCreated |> Array.head).AsOf).TotalDays |> int).ToString "N0" + ((asOf - (req.History |> List.filter History.isCreated |> List.head).AsOf).TotalDays |> int).ToString "N0" let lastText = req.History - |> Array.filter (fun h -> Option.isSome h.Text) - |> Array.sortByDescending (fun h -> h.AsOf) - |> Array.map (fun h -> Option.get h.Text) - |> Array.head + |> Seq.ofList + |> Seq.filter (fun h -> Option.isSome h.Text) + |> Seq.sortByDescending (fun h -> h.AsOf) + |> Seq.map (fun h -> Option.get h.Text) + |> Seq.head // The history log including notes (and excluding the final entry for answered requests) let log = let toDisp (h : History) = {| asOf = h.AsOf; text = h.Text; status = RequestAction.toString h.Status |} let all = req.Notes - |> Array.map (fun n -> {| asOf = n.AsOf; text = Some n.Notes; status = "Notes" |}) - |> Array.append (req.History |> Array.map toDisp) - |> Array.sortByDescending (fun it -> it.asOf) - |> List.ofArray + |> Seq.ofList + |> Seq.map (fun n -> {| asOf = n.AsOf; text = Some n.Notes; status = "Notes" |}) + |> Seq.append (req.History |> List.map toDisp) + |> Seq.sortByDescending (fun it -> it.asOf) + |> List.ofSeq // Skip the first entry for answered requests; that info is already displayed match answered with Some _ -> all.Tail | None -> all article [ _class "container mt-3" ] [