Finish recurrent model change

Also fix IDE warnings, update to htmx 1.6.1

src/MyPrayerJournal/Data.fs

@@ -1,8 +1,8 @@
 module MyPrayerJournal.Data
 
 open LiteDB
+open MyPrayerJournal
 open NodaTime
-open System
 open System.Threading.Tasks
 
 // fsharplint:disable MemberNames
@@ -37,6 +37,11 @@ module Mapping =
     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
@@ -52,65 +57,10 @@ module Mapping =
     let fromBson (value : BsonValue) = UserId value.AsString
     let toBson (value : UserId) : BsonValue = UserId.toString value
     
-  /// Map a history entry to BSON
-  let historyToBson (hist : History) : BsonValue =
-    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
-  let historyFromBson (doc : BsonValue) =
-    { 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
-  let noteToBson (note : Note) : BsonValue =
-    let doc = BsonDocument ()
-    doc["asOf"]  <- note.asOf.ToUnixTimeMilliseconds ()
-    doc["notes"] <- note.notes
-    upcast doc
-
-  /// Map a BSON document to a note entry
-  let noteFromBson (doc : BsonValue) =
-    { asOf  = Instant.FromUnixTimeMilliseconds doc["asOf"].AsInt64
-      notes = doc["notes"].AsString
-      }
-
-  /// Map a request to its BSON representation
-  let requestToBson req : BsonValue =
-    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
-  let requestFromBson (doc : BsonValue) =
-    { id           = RequestId.ofString doc["_id"].AsString
-      enteredOn    = Instant.FromUnixTimeMilliseconds doc["enteredOn"].AsInt64
-      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
   let register () = 
-    BsonMapper.Global.RegisterType<Request>(requestToBson, requestFromBson)
     BsonMapper.Global.RegisterType<Instant>(Instant.toBson, Instant.fromBson)
+    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)
@@ -217,9 +167,9 @@ let tryJournalById reqId userId (db : LiteDatabase) = backgroundTask {
   }
     
 /// 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
-  | 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"
   }
 

src/MyPrayerJournal/Domain.fs

@@ -1,5 +1,5 @@
-[<AutoOpen>]
+/// The data model for myPrayerJournal
-/// The data model for myPrayerJournal
+[<AutoOpen>]
 module MyPrayerJournal.Domain
 
 // fsharplint:disable RecordFieldNames
@@ -111,10 +111,8 @@ type Request = {
   snoozedUntil : Instant
   /// The time at which this request should reappear in the user's journal by recurrence
   showAfter    : Instant
-  /// The type of recurrence for this request
+  /// The recurrence for this request
-  recurType    : Recurrence
+  recurrence   : Recurrence
-  /// How many of the recurrence intervals should occur between appearances in the journal
-  recurCount   : int16
   /// The history entries for this request
   history      : History list
   /// The notes for this request
@@ -128,8 +126,7 @@ with
       userId       = UserId ""
       snoozedUntil = Instant.MinValue
       showAfter    = Instant.MinValue
-      recurType    = Immediate
+      recurrence   = Immediate
-      recurCount   = 0s
       history      = []
       notes        = []
       }
@@ -152,10 +149,8 @@ type JournalRequest = {
   snoozedUntil : Instant
   /// The time after which this request should reappear in the user's journal by configured recurrence
   showAfter    : Instant
-  /// The type of recurrence for this request
+  /// The recurrence for this request
-  recurType    : Recurrence
+  recurrence   : Recurrence
-  /// How many of the recurrence intervals should occur between appearances in the journal
-  recurCount   : int16
   /// History entries for the request
   history      : History list
   /// Note entries for the request
@@ -180,8 +175,7 @@ module JournalRequest =
       lastStatus   = match hist with Some h -> h.status | None -> Created
       snoozedUntil = req.snoozedUntil
       showAfter    = req.showAfter
-      recurType    = req.recurType
+      recurrence   = req.recurrence
-      recurCount   = req.recurCount
       history      = []
       notes        = []
       }

src/MyPrayerJournal/Handlers.fs

@@ -37,10 +37,10 @@ module Error =
     log.LogError (EventId(), ex, "An unhandled exception has occurred while executing the request.")
     clearResponse
     >=> setStatusCode 500
-    >=> setHttpHeader "X-Toast" (sprintf "error|||%s: %s" (ex.GetType().Name) ex.Message)
+    >=> setHttpHeader "X-Toast" $"error|||{ex.GetType().Name}: {ex.Message}"
     >=> text ex.Message
 
-  /// Handle unauthorized actions, redirecting to log on for GETs, otherwise returning a 401 Not Authorized reponse
+  /// Handle unauthorized actions, redirecting to log on for GETs, otherwise returning a 401 Not Authorized response
   let notAuthorized : HttpHandler =
     fun next ctx ->
       (next, ctx)
@@ -97,7 +97,7 @@ module private Helpers =
   /// Return a 201 CREATED response with the location header set for the created resource
   let createdAt url : HttpHandler =
     fun next ctx ->
-      (sprintf "%s://%s%s" ctx.Request.Scheme ctx.Request.Host.Value url |> setHttpHeader HeaderNames.Location
+      ($"{ctx.Request.Scheme}://{ctx.Request.Host.Value}{url}" |> setHttpHeader HeaderNames.Location
        >=> created) next ctx
   
   /// Return a 303 SEE OTHER response (forces a GET on the redirected URL)
@@ -107,7 +107,7 @@ module private Helpers =
   /// Render a component result
   let renderComponent nodes : HttpHandler =
     noResponseCaching
-    >=> fun next ctx -> backgroundTask {
+    >=> fun _ ctx -> backgroundTask {
       return! ctx.WriteHtmlStringAsync (ViewEngine.RenderView.AsString.htmlNodes nodes)
       }
 
@@ -131,7 +131,7 @@ module private Helpers =
 
   /// Composable handler to write a view to the output
   let writeView view : HttpHandler =
-    fun next ctx -> backgroundTask {
+    fun _ ctx -> backgroundTask {
       return! ctx.WriteHtmlViewAsync view
       }
 
@@ -139,7 +139,7 @@ module private Helpers =
   module Messages =
 
     /// The messages being held
-    let mutable private messages : Map<string, (string * string)> = Map.empty
+    let mutable private messages : Map<string, string * string> = Map.empty
 
     /// Locked update to prevent updates by multiple threads
     let private upd8 = obj ()
@@ -150,7 +150,7 @@ module private Helpers =
 
     /// Add a success message header to the response
     let pushSuccess ctx message url =
-      push ctx (sprintf "success|||%s" message) url
+      push ctx $"success|||{message}" url
     
     /// Pop the messages for the given user
     let pop userId = lock upd8 (fun () ->
@@ -289,7 +289,7 @@ module Journal =
         |> Option.map (fun c -> c.Value)
         |> Option.defaultValue "Your"
       let title = usr |> match usr with "Your" -> sprintf "%s" | _ -> sprintf "%s's"
-      return! partial (sprintf "%s Prayer Journal" title) (Views.Journal.journal usr) next ctx
+      return! partial $"{title} Prayer Journal" (Views.Journal.journal usr) next ctx
     }
 
 
@@ -343,9 +343,9 @@ module Request =
           let now  = now ctx
           do! Data.addHistory reqId usrId { asOf = now; status = Prayed; text = None } db
           let nextShow =
-            match Recurrence.duration req.recurType with
+            match Recurrence.duration req.recurrence with
             | 0L       -> Instant.MinValue
-            | duration -> now.Plus (Duration.FromSeconds (duration * int64 req.recurCount))
+            | duration -> now.Plus (Duration.FromSeconds duration)
           do! Data.updateShowAfter reqId usrId nextShow db
           do! db.saveChanges ()
           return! (withSuccessMessage "Request marked as prayed" >=> Components.journalItems) next ctx
@@ -465,10 +465,10 @@ module Request =
       | None -> return! Error.notFound next ctx
       }
 
-  /// Derive a recurrence and interval from its primitive representation in the form
+  /// Derive a recurrence from its representation in the form
   let private parseRecurrence (form : Models.Request) =
-    (Recurrence.ofString (match form.recurInterval with Some x -> x | _ -> "Immediate"),
+    match form.recurInterval with Some x -> $"{defaultArg form.recurCount 0s} {x}" | None -> "Immediate"
-     defaultArg form.recurCount (int16 0))
+    |> Recurrence.ofString
 
   // POST /request
   let add : HttpHandler =
@@ -478,14 +478,12 @@ module Request =
       let  db    = db ctx
       let  usrId = userId ctx
       let  now   = now ctx
-      let (recur, interval) = parseRecurrence form
       let  req   =
         { Request.empty with
             userId     = usrId
             enteredOn  = now
             showAfter  = Instant.MinValue
-            recurType  = recur
+            recurrence = parseRecurrence form
-            recurCount = interval
             history    = [
               { asOf   = now
                 status = Created
@@ -509,11 +507,11 @@ module Request =
       match! Data.tryJournalById (RequestId.ofString form.requestId) usrId db with
       | Some req ->
           // update recurrence if changed
-          let (recur, interval) = parseRecurrence form
+          let recur = parseRecurrence form
-          match recur = req.recurType && interval = req.recurCount with
+          match recur = req.recurrence with
           | true  -> ()
           | false ->
-              do! Data.updateRecurrence req.requestId usrId recur interval db
+              do! Data.updateRecurrence req.requestId usrId recur db
               match recur with
               | Immediate -> do! Data.updateShowAfter req.requestId usrId Instant.MinValue db
               | _         -> ()

src/MyPrayerJournal/MyPrayerJournal.fsproj

@@ -2,6 +2,7 @@
   <PropertyGroup>
     <TargetFramework>net6.0</TargetFramework>
     <Version>3.0.0.0</Version>
+    <NoWarn>3391</NoWarn>
   </PropertyGroup>
   <ItemGroup>
     <Compile Include="Domain.fs" />
@@ -19,8 +20,8 @@
     <PackageReference Include="FSharp.SystemTextJson" Version="0.17.4" />
     <PackageReference Include="FunctionalCuid" Version="1.0.0" />
     <PackageReference Include="Giraffe" Version="5.0.0" />
-    <PackageReference Include="Giraffe.Htmx" Version="0.9.2" />
+    <PackageReference Include="Giraffe.Htmx" Version="1.6.1" />
-    <PackageReference Include="Giraffe.ViewEngine.Htmx" Version="0.9.2" />
+    <PackageReference Include="Giraffe.ViewEngine.Htmx" Version="1.6.1" />
     <PackageReference Include="LiteDB" Version="5.0.11" />
     <PackageReference Include="Microsoft.AspNetCore.Authentication.OpenIdConnect" Version="5.0.10" />
     <PackageReference Include="NodaTime" Version="3.0.9" />

src/MyPrayerJournal/Program.fs

@@ -84,17 +84,17 @@ module Configure =
           opts.OnAppendCookie        <- fun ctx -> sameSite ctx.CookieOptions
           opts.OnDeleteCookie        <- fun ctx -> sameSite ctx.CookieOptions)
       .AddAuthentication(
-        /// Use HTTP "Bearer" authentication with JWTs
+        // 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
+        // Configure OIDC with Auth0 options from configuration
         fun opts ->
           let cfg = bldr.Configuration.GetSection "Auth0"
-          opts.Authority    <- sprintf "https://%s/" cfg["Domain"]
+          opts.Authority    <- $"""https://{cfg["Domain"]}/"""
           opts.ClientId     <- cfg["Id"]
           opts.ClientSecret <- cfg["Secret"]
           opts.ResponseType <- OpenIdConnectResponseType.Code
@@ -118,11 +118,10 @@ module Configure =
                     | true ->
                         // transform to absolute
                         let request = ctx.Request
-                        sprintf "%s://%s%s%s" request.Scheme request.Host.Value request.PathBase.Value redirUri
+                        $"{request.Scheme}://{request.Host.Value}{request.PathBase.Value}{redirUri}"
                     | false -> redirUri
-                  Uri.EscapeDataString finalRedirUri |> sprintf "&returnTo=%s"
+                  Uri.EscapeDataString $"&returnTo={finalRedirUri}"
-            sprintf "https://%s/v2/logout?client_id=%s%s" cfg["Domain"] cfg["Id"] returnTo
+            ctx.Response.Redirect $"""https://{cfg["Domain"]}/v2/logout?client_id={cfg["Id"]}{returnTo}"""
-            |> ctx.Response.Redirect
             ctx.HandleResponse ()
 
             Task.CompletedTask
@@ -159,7 +158,7 @@ module Configure =
       .UseRouting()
       .UseAuthentication()
       .UseGiraffeErrorHandler(Handlers.Error.error)
-      .UseEndpoints (fun e -> e.MapGiraffeEndpoints Handlers.routes |> ignore)
+      .UseEndpoints (fun e -> e.MapGiraffeEndpoints Handlers.routes)
     |> ignore
     app
 

src/MyPrayerJournal/Views/Layout.fs

@@ -110,11 +110,7 @@ let htmlFoot =
           ]
         ]
       ]
-    script [
+    Htmx.Script.minified
-      _src         "https://unpkg.com/htmx.org@1.5.0"
-      _integrity   "sha384-oGA+prIp5Vchu6we2YkI51UtVzN9Jpx2Z7PnR1I78PnZlN8LkrCT4lqqqmDkyrvI"
-      _crossorigin "anonymous"
-      ] []
     script [] [
       rawText "if (!htmx) document.write('<script src=\"/script/htmx-1.5.0.min.js\"><\/script>')"
       ]

src/MyPrayerJournal/Views/Request.fs

@@ -5,7 +5,6 @@ open Giraffe.ViewEngine
 open Giraffe.ViewEngine.Htmx
 open MyPrayerJournal
 open NodaTime
-open System
 
 /// Create a request within the list
 let reqListItem now req =
@@ -142,6 +141,14 @@ let edit (req : JournalRequest) returnTo isNew =
     | "active"          -> "/requests/active"
     | "snoozed"         -> "/requests/snoozed"
     | _ (* "journal" *) -> "/journal"
+  let recurCount =
+    match req.recurrence with
+    | Immediate -> None
+    | Hours   h -> Some h
+    | Days    d -> Some d
+    | Weeks   w -> Some w
+    |> Option.map string
+    |> Option.defaultValue ""
   article [ _class "container" ] [
     h2 [ _class "pb-3" ] [ (match isNew with true -> "Add" | false -> "Edit") |> strf "%s Prayer Request" ]
     form [
@@ -202,7 +209,7 @@ let edit (req : JournalRequest) returnTo isNew =
                 _name    "recurType"
                 _value   "Immediate"
                 _onclick "mpj.edit.toggleRecurrence(event)"
-                match req.recurType with Immediate -> _checked | _ -> ()
+                match req.recurrence with Immediate -> _checked | _ -> ()
                 ]
               label [ _for "rI" ] [ str "Immediately" ]
               ]
@@ -214,7 +221,7 @@ let edit (req : JournalRequest) returnTo isNew =
                 _name    "recurType"
                 _value   "Other"
                 _onclick "mpj.edit.toggleRecurrence(event)"
-                match req.recurType with Immediate -> () | _ -> _checked
+                match req.recurrence with Immediate -> () | _ -> _checked
                 ]
               label [ _for "rO" ] [ rawText "Every…" ]
               ]
@@ -225,10 +232,10 @@ let edit (req : JournalRequest) returnTo isNew =
                 _id          "recurCount"
                 _name        "recurCount"
                 _placeholder "0"
-                _value       (string req.recurCount)
+                _value       recurCount
                 _style       "width:6rem;"
                 _required
-                match req.recurType with Immediate -> _disabled | _ -> ()
+                match req.recurrence with Immediate -> _disabled | _ -> ()
                 ]
               label [ _for "recurCount" ] [ str "Count" ]
               ]
@@ -239,11 +246,11 @@ let edit (req : JournalRequest) returnTo isNew =
                 _name     "recurInterval"
                 _style    "width:6rem;"
                 _required
-                match req.recurType with Immediate -> _disabled | _ -> ()
+                match req.recurrence with Immediate -> _disabled | _ -> ()
                 ] [
-                option [ _value "Hours"; match req.recurType with Hours -> _selected | _ -> () ] [ str "hours" ]
+                option [ _value "Hours"; match req.recurrence with Hours _ -> _selected | _ -> () ] [ str "hours" ]
-                option [ _value "Days";  match req.recurType with Days  -> _selected | _ -> () ] [ str "days" ]
+                option [ _value "Days";  match req.recurrence with Days  _ -> _selected | _ -> () ] [ str "days" ]
-                option [ _value "Weeks"; match req.recurType with Weeks -> _selected | _ -> () ] [ str "weeks" ]
+                option [ _value "Weeks"; match req.recurrence with Weeks _ -> _selected | _ -> () ] [ str "weeks" ]
                 ]
               label [ _form "recurInterval" ] [ str "Interval" ]
               ]