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

WIP on data migration

Browse Source
This commit is contained in:
Daniel J. Summers 2023-10-07 19:37:44 -04:00
parent cc4347bc6e
commit 399b15db9c
10 changed files with 168 additions and 240 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

106
src/MyPrayerJournal.ToPostgres/LiteData.fs Normal file
View File

@ -0,0 +1,106 @@
module MyPrayerJournal.LiteData
open LiteDB
open MyPrayerJournal
open NodaTime
/// 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 : 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
[<AutoOpen>]
module Extensions =
/// Extensions on the LiteDatabase class
type LiteDatabase with
/// The Request collection
member this.Requests = this.GetCollection<OldRequest> "request"
/// Map domain to LiteDB
// It does mapping, but since we're so DU-heavy, this gives us control over the JSON representation
[<RequireQualifiedAccess>]
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>(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
module Startup =
/// Ensure the database is set up
let ensureDb (db : LiteDatabase) =
db.Requests.EnsureIndex (fun it -> it.UserId) |> ignore
Mapping.register ()

7
src/MyPrayerJournal.ToPostgres/MyPrayerJournal.ToPostgres.fsproj
View File

@ -3,9 +3,11 @@
<PropertyGroup>
<OutputType>Exe</OutputType>
<TargetFramework>net7.0</TargetFramework>
<NoWarn>3391</NoWarn>
</PropertyGroup>
<ItemGroup>
<Compile Include="LiteData.fs" />
<Compile Include="Program.fs" />
</ItemGroup>
@ -13,4 +15,9 @@
<ProjectReference Include="..\MyPrayerJournal\MyPrayerJournal.fsproj" />
</ItemGroup>
<ItemGroup>
<PackageReference Include="LiteDB" Version="5.0.17" />
<PackageReference Update="FSharp.Core" Version="7.0.400" />
</ItemGroup>
</Project>

11
src/MyPrayerJournal.ToPostgres/Program.fs
View File

@ -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

6
src/MyPrayerJournal.sln
View File

@ -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

12
src/MyPrayerJournal/Data.fs
View File

@ -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 []
}

29
src/MyPrayerJournal/Domain.fs
View File

@ -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
}

6
src/MyPrayerJournal/Handlers.fs
View File

@ -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"

199
src/MyPrayerJournal/LiteData.fs
View File

@ -1,199 +0,0 @@
module MyPrayerJournal.LiteData
open LiteDB
open MyPrayerJournal
open System.Threading.Tasks
/// LiteDB extensions
[<AutoOpen>]
module Extensions =
/// Extensions on the LiteDatabase class
type LiteDatabase with
/// The Request collection
member this.Requests = this.GetCollection<Request> "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
[<RequireQualifiedAccess>]
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>(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
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
[<AutoOpen>]
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"
}

5
src/MyPrayerJournal/MyPrayerJournal.fsproj
View File

@ -1,14 +1,12 @@
<Project Sdk="Microsoft.NET.Sdk.Web">
<PropertyGroup>
<TargetFramework>net7.0</TargetFramework>
<Version>3.2</Version>
<Version>3.3</Version>
<DebugType>embedded</DebugType>
<GenerateDocumentationFile>false</GenerateDocumentationFile>
<NoWarn>3391</NoWarn>
</PropertyGroup>
<ItemGroup>
<Compile Include="Domain.fs" />
<Compile Include="LiteData.fs" />
<Compile Include="Data.fs" />
<Compile Include="Dates.fs" />
<Compile Include="Views/Helpers.fs" />
@ -26,7 +24,6 @@
<PackageReference Include="Giraffe" Version="6.0.0" />
<PackageReference Include="Giraffe.Htmx" Version="1.9.6" />
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.9.6" />
<PackageReference Include="LiteDB" Version="5.0.16" />
<PackageReference Include="Microsoft.AspNetCore.Authentication.OpenIdConnect" Version="7.0.5" />
<PackageReference Include="NodaTime.Serialization.SystemTextJson" Version="1.1.2" />
<PackageReference Include="Npgsql.NodaTime" Version="7.0.6" />

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

@ -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" ] [