Implement htmax as auto-htmx selection (#59)

- Move program support items to MyWebLog namespace
- Fix parameter ordering in some tests

src/MyWebLog.Data/RethinkDbData.fs

@@ -267,13 +267,13 @@ type RethinkDbData(conn: Net.IConnection, config: DataConfig, log: ILogger<Rethi
         do! rethink {
             withTable Table.WebLog
             filter (nameof WebLog.Empty.AutoHtmx) true
-            update [ nameof WebLog.Empty.AutoHtmx, "Yes" ]
+            update [ nameof WebLog.Empty.AutoHtmx, "Yes" :> obj ]
             write; withRetryOnce; ignoreResult conn
         }
         do! rethink {
             withTable Table.WebLog
             filter (nameof WebLog.Empty.AutoHtmx) false
-            update [ nameof WebLog.Empty.AutoHtmx, "No" ]
+            update [ nameof WebLog.Empty.AutoHtmx, "No" :> obj ]
             write; withRetryOnce; ignoreResult conn
         }
         Utils.Migration.logStep log "v2.2 to v3" "Setting database version to v3"

src/MyWebLog.Domain/SupportTypes.fs

@@ -105,17 +105,17 @@ type AccessLevel =
         AccessLevel.Weights[needed] <= AccessLevel.Weights[this]
 
 
-/// <summary>How the htmx library will be auto-injected in a web log's theme pages</summary>
+/// <summary>How the htmx library will be auto-injected in a web log's templates</summary>
 [<Struct>]
 type AutoHtmxType =
-    
+
-    /// <summary>Do not auto-inject htmx into the web log's theme pages</summary>
+    /// <summary>Do not auto-inject htmx into the web log's templates</summary>
     | NoAutoHtmx
-    
+
-    /// <summary>Inject the standard htmx library into the web log's theme pages</summary>
+    /// <summary>Inject the standard htmx library into the web log's templates</summary>
     | AutoHtmx
-    
+
-    /// <summary>Inject the htmax library bundle into the web log's theme pages</summary>
+    /// <summary>Inject the htmax library bundle into the web log's templates</summary>
     | AutoHtmax
 
     /// <summary>Parse an auto-htmx type from its string representation</summary>
@@ -628,7 +628,7 @@ type OpenGraphType =
           string VideoOther,        "Video: Other"
           string VideoTvShow,       "Video: TV Show"
           string Website,           nameof Website ]
-    
+
     override this.ToString() =
         match this with
         | Article -> "article"

src/MyWebLog.Tests/Data/ConvertersTests.fs

@@ -6,6 +6,20 @@ open MyWebLog
 open MyWebLog.Converters.Json
 open Newtonsoft.Json
 
+/// Unit tests for the AutoHtmxTypeConverter type
+let autoHtmxTypeConverterTests = testList "AutoHtmxTypeConverter" [
+    let opts = JsonSerializerSettings()
+    opts.Converters.Add(AutoHtmxTypeConverter())
+    test "succeeds when serializing" {
+        let after = JsonConvert.SerializeObject(AutoHtmax, opts)
+        Expect.equal after "\"Max\"" "Auto htmx type serialized incorrectly"
+    }
+    test "succeeds when deserializing" {
+        let after = JsonConvert.DeserializeObject<AutoHtmxType>("\"Yes\"", opts)
+        Expect.equal after AutoHtmx "Auto htmx type not serialized incorrectly"
+    }
+]
+
 /// Unit tests for the CategoryIdConverter type
 let categoryIdConverterTests = testList "CategoryIdConverter" [
     let opts = JsonSerializerSettings()
@@ -264,6 +278,7 @@ open NodaTime.Serialization.JsonNet
 let configureTests = test "Json.configure succeeds" {
     let has typ (converter: JsonConverter) = converter.GetType() = typ
     let ser = configure (JsonSerializer.Create())
+    Expect.hasCountOf ser.Converters 1u (has typeof<AutoHtmxTypeConverter>) "Auto htmx type converter not found"
     Expect.hasCountOf ser.Converters 1u (has typeof<CategoryIdConverter>) "Category ID converter not found"
     Expect.hasCountOf ser.Converters 1u (has typeof<CommentIdConverter>) "Comment ID converter not found"
     Expect.hasCountOf ser.Converters 1u (has typeof<CommentStatusConverter>) "Comment status converter not found"
@@ -290,6 +305,7 @@ let configureTests = test "Json.configure succeeds" {
 
 /// All tests for the Data.Converters file
 let all = testList "Converters" [
+    autoHtmxTypeConverterTests
     categoryIdConverterTests
     commentIdConverterTests
     commentStatusConverterTests

src/MyWebLog.Tests/Data/WebLogDataTests.fs

@@ -30,7 +30,7 @@ let ``Add succeeds`` (data: IData) = task {
                     IsTagEnabled      = false
                     Copyright         = Some "go for it"
                     CustomFeeds       = [] }
-              AutoHtmx      = true
+              AutoHtmx      = AutoHtmax
               Uploads       = Disk
               RedirectRules = [ { From = "/here"; To = "/there"; IsRegex = false } ]
               AutoOpenGraph = false }
@@ -46,7 +46,7 @@ let ``Add succeeds`` (data: IData) = task {
     Expect.equal it.ThemeId (ThemeId "default") "Theme ID is incorrect"
     Expect.equal it.UrlBase "https://example.com/new" "URL base is incorrect"
     Expect.equal it.TimeZone "America/Los_Angeles" "Time zone is incorrect"
-    Expect.isTrue it.AutoHtmx "Auto htmx flag is incorrect"
+    Expect.equal it.AutoHtmx AutoHtmax "Auto htmx type is incorrect"
     Expect.equal it.Uploads Disk "Upload destination is incorrect"
     Expect.equal it.RedirectRules [ { From = "/here"; To = "/there"; IsRegex = false } ] "Redirect rules are incorrect"
     Expect.isFalse it.AutoOpenGraph "Auto OpenGraph flag is incorrect"
@@ -91,7 +91,7 @@ let ``FindById succeeds when a web log is found`` (data: IData) = task {
     Expect.equal it.ThemeId (ThemeId "default") "Theme ID is incorrect"
     Expect.equal it.UrlBase "http://localhost:8081" "URL base is incorrect"
     Expect.equal it.TimeZone "America/Denver" "Time zone is incorrect"
-    Expect.isTrue it.AutoHtmx "Auto htmx flag is incorrect"
+    Expect.equal it.AutoHtmx AutoHtmx "Auto htmx type is incorrect"
     Expect.equal it.Uploads Database "Upload destination is incorrect"
     Expect.isEmpty it.RedirectRules "Redirect rules are incorrect"
     let rss = it.Rss
@@ -165,10 +165,10 @@ let ``UpdateRssOptions succeeds when the web log does not exist`` (data: IData)
 let ``UpdateSettings succeeds when the web log exists`` (data: IData) = task {
     let! webLog = data.WebLog.FindById rootId
     Expect.isSome webLog "The root web log should have been returned"
-    do! data.WebLog.UpdateSettings { webLog.Value with AutoHtmx = false; Subtitle = None }
+    do! data.WebLog.UpdateSettings { webLog.Value with AutoHtmx = NoAutoHtmx; Subtitle = None }
     let! updated = data.WebLog.FindById rootId
     Expect.isSome updated "The updated web log should have been returned"
-    Expect.isFalse updated.Value.AutoHtmx "Auto htmx flag not updated correctly"
+    Expect.equal updated.Value.AutoHtmx NoAutoHtmx "Auto htmx type not updated correctly"
     Expect.isNone updated.Value.Subtitle "Subtitle not updated correctly"
 }
 

src/MyWebLog.Tests/Domain/SupportTypesTests.fs

@@ -31,16 +31,16 @@ let nodaTests = testList "Noda" [
 let accessLevelTests = testList "AccessLevel" [
     testList "Parse" [
         test "succeeds for \"Author\"" {
-            Expect.equal Author (AccessLevel.Parse "Author") "Author not parsed correctly"
+            Expect.equal (AccessLevel.Parse "Author") Author "Author not parsed correctly"
         }
         test "succeeds for \"Editor\"" {
-            Expect.equal Editor (AccessLevel.Parse "Editor") "Editor not parsed correctly"
+            Expect.equal (AccessLevel.Parse "Editor") Editor "Editor not parsed correctly"
         }
         test "succeeds for \"WebLogAdmin\"" {
-            Expect.equal WebLogAdmin (AccessLevel.Parse "WebLogAdmin") "WebLogAdmin not parsed correctly"
+            Expect.equal (AccessLevel.Parse "WebLogAdmin") WebLogAdmin "WebLogAdmin not parsed correctly"
         }
         test "succeeds for \"Administrator\"" {
-            Expect.equal Administrator (AccessLevel.Parse "Administrator") "Administrator not parsed correctly"
+            Expect.equal (AccessLevel.Parse "Administrator") Administrator "Administrator not parsed correctly"
         }
         test "fails when given an unrecognized value" {
             Expect.throwsT<ArgumentException>
@@ -113,17 +113,47 @@ let accessLevelTests = testList "AccessLevel" [
     ]
 ]
 
+/// Tests for the AutoHtmxType type
+let autoHtmxTypeTests = testList "AutoHtmxType" [
+    testList "Parse" [
+        test "succeeds for \"NoAutoHtmx\"" {
+            Expect.equal (AutoHtmxType.Parse "No") NoAutoHtmx "No not parsed correctly"
+        }
+        test "succeeds for \"AutoHtmx\"" {
+            Expect.equal (AutoHtmxType.Parse "Yes") AutoHtmx "Yes not parsed correctly"
+        }
+        test "succeeds for \"AutoHtmax\"" {
+            Expect.equal (AutoHtmxType.Parse "Max") AutoHtmax "Max not parsed correctly"
+        }
+        test "fails for unrecognized value" {
+            Expect.throwsT<ArgumentException>
+                (fun () -> ignore (AutoHtmxType.Parse "Sure")) "Invalid value should have raised an exception"
+        }
+    ]
+    testList "ToString" [
+        test "NoAutoHtmx succeeds" {
+            Expect.equal (string NoAutoHtmx) "No" "NoAutoHtmx string incorrect"
+        }
+        test "AutoHtmx succeeds" {
+            Expect.equal (string AutoHtmx) "Yes" "AutoHtmx string incorrect"
+        }
+        test "AutoHtmax succeeds" {
+            Expect.equal (string AutoHtmax) "Max" "AutoHtmax string incorrect"
+        }
+    ]
+]
+
 /// Tests for the CommentStatus type
 let commentStatusTests = testList "CommentStatus" [
     testList "Parse" [
         test "succeeds for \"Approved\"" {
-            Expect.equal Approved (CommentStatus.Parse "Approved") "Approved not parsed correctly"
+            Expect.equal (CommentStatus.Parse "Approved") Approved "Approved not parsed correctly"
         }
         test "succeeds for \"Pending\"" {
-            Expect.equal Pending (CommentStatus.Parse "Pending") "Pending not parsed correctly"
+            Expect.equal (CommentStatus.Parse "Pending") Pending "Pending not parsed correctly"
         }
         test "succeeds for \"Spam\"" {
-            Expect.equal Spam (CommentStatus.Parse "Spam") "Spam not parsed correctly"
+            Expect.equal (CommentStatus.Parse "Spam") Spam "Spam not parsed correctly"
         }
         test "fails for unrecognized value" {
             Expect.throwsT<ArgumentException>
@@ -147,13 +177,13 @@ let commentStatusTests = testList "CommentStatus" [
 let explicitRatingTests = testList "ExplicitRating" [
     testList "Parse" [
         test "succeeds for \"yes\"" {
-            Expect.equal Yes (ExplicitRating.Parse "yes") "\"yes\" not parsed correctly"
+            Expect.equal (ExplicitRating.Parse "yes") Yes "\"yes\" not parsed correctly"
         }
         test "succeeds for \"no\"" {
-            Expect.equal No (ExplicitRating.Parse "no") "\"no\" not parsed correctly"
+            Expect.equal (ExplicitRating.Parse "no") No "\"no\" not parsed correctly"
         }
         test "succeeds for \"clean\"" {
-            Expect.equal Clean (ExplicitRating.Parse "clean") "\"clean\" not parsed correctly"
+            Expect.equal (ExplicitRating.Parse "clean") Clean "\"clean\" not parsed correctly"
         }
         test "fails for unrecognized value" {
             Expect.throwsT<ArgumentException>
@@ -780,6 +810,7 @@ let uploadDestinationTests = testList "UploadDestination" [
 let all = testList "SupportTypes" [
     nodaTests
     accessLevelTests
+    autoHtmxTypeTests
     commentStatusTests
     explicitRatingTests
     episodeTests

src/MyWebLog.Tests/Domain/ViewModelsTests.fs

@@ -1363,7 +1363,7 @@ let settingsModelTests = testList "SettingsModel" [
                         PostsPerPage  = 18
                         TimeZone      = "America/Denver"
                         ThemeId       = ThemeId "my-theme"
-                        AutoHtmx      = true
+                        AutoHtmx      = AutoHtmx
                         AutoOpenGraph = false }
             Expect.equal model.Name "The Web Log" "Name not filled properly"
             Expect.equal model.Slug "the-web-log" "Slug not filled properly"
@@ -1372,7 +1372,7 @@ let settingsModelTests = testList "SettingsModel" [
             Expect.equal model.PostsPerPage 18 "PostsPerPage not filled properly"
             Expect.equal model.TimeZone "America/Denver" "TimeZone not filled properly"
             Expect.equal model.ThemeId "my-theme" "ThemeId not filled properly"
-            Expect.isTrue model.AutoHtmx "AutoHtmx should have been set"
+            Expect.equal model.AutoHtmx (string AutoHtmx) "AutoHtmx should have been set"
             Expect.equal model.Uploads "Database" "Uploads not filled properly"
             Expect.isFalse model.AutoOpenGraph "AutoOpenGraph should have been unset"
         }
@@ -1391,7 +1391,7 @@ let settingsModelTests = testList "SettingsModel" [
                   PostsPerPage  = 8
                   TimeZone      = "America/Chicago"
                   ThemeId       = "test-theme"
-                  AutoHtmx      = true
+                  AutoHtmx      = (string AutoHtmax)
                   Uploads       = "Disk"
                   AutoOpenGraph = false }.Update WebLog.Empty
             Expect.equal webLog.Name "Interesting" "Name not filled properly"
@@ -1401,7 +1401,7 @@ let settingsModelTests = testList "SettingsModel" [
             Expect.equal webLog.PostsPerPage 8 "PostsPerPage not filled properly"
             Expect.equal webLog.TimeZone "America/Chicago" "TimeZone not filled properly"
             Expect.equal webLog.ThemeId (ThemeId "test-theme") "ThemeId not filled properly"
-            Expect.isTrue webLog.AutoHtmx "AutoHtmx should have been set"
+            Expect.equal webLog.AutoHtmx AutoHtmax "AutoHtmx should have been set"
             Expect.equal webLog.Uploads Disk "Uploads not filled properly"
             Expect.isFalse webLog.AutoOpenGraph "AutoOpenGraph should have been unset"
         }

src/MyWebLog.Tests/root-weblog.json

@@ -41,7 +41,7 @@
         }
       ]
     },
-    "AutoHtmx": true,
+    "AutoHtmx": "Yes",
     "Uploads": "Database",
     "RedirectRules": []
   },

src/MyWebLog/Handlers/Admin.fs

@@ -516,12 +516,17 @@ module WebLog =
                 |> List.sortBy _.Title.ToLower()
                 |> List.append [ { Page.Empty with Id = PageId "posts"; Title = "- First Page of Posts -" } ]
             let! themes   = data.Theme.All()
+            let  htmxOpts =
+                [ string NoAutoHtmx, "None"
+                  string AutoHtmx, "htmx Library"
+                  string AutoHtmax, "htmax Bundle" ]
             let  uploads  = [ Database; Disk ]
             return!
                 Views.WebLog.webLogSettings
                     (SettingsModel.FromWebLog ctx.WebLog)
                     themes
                     pages
+                    htmxOpts
                     uploads
                     (EditRssModel.FromRssOptions ctx.WebLog.Rss)
                 |> adminPage "Web Log Settings" next ctx

src/MyWebLog/MyWebLog.fsproj

@@ -26,6 +26,7 @@
     <Compile Include="Handlers\Routes.fs" />
     <Compile Include="DotLiquidBespoke.fs" />
     <Compile Include="Maintenance.fs" />
+    <Compile Include="ProgramSupport.fs" />
     <Compile Include="Program.fs" />
   </ItemGroup>
 

src/MyWebLog/Program.fs

@@ -1,117 +1,4 @@
-open Microsoft.AspNetCore.Http
+/// Show a list of valid command-line interface commands
-open Microsoft.Extensions.Logging
-open MyWebLog
-
-/// Middleware to derive the current web log
-type WebLogMiddleware(next: RequestDelegate, log: ILogger<WebLogMiddleware>) =
-
-    /// Is the debug level enabled on the logger?
-    let isDebug = log.IsEnabled LogLevel.Debug
-
-    member _.InvokeAsync(ctx: HttpContext) = task {
-        /// Create the full path of the request
-        let path = $"{ctx.Request.Scheme}://{ctx.Request.Host.Value}{ctx.Request.Path.Value}"
-        match WebLogCache.tryGet path with
-        | Some webLog ->
-            if isDebug then log.LogDebug $"Resolved web log {webLog.Id} for {path}"
-            ctx.Items["webLog"] <- webLog
-            if PageListCache.exists ctx then () else do! PageListCache.update ctx
-            if CategoryCache.exists ctx then () else do! CategoryCache.update ctx
-            if webLog.ExtraPath <> "" then
-                ctx.Request.PathBase <- PathString(webLog.ExtraPath)
-                ctx.Request.Path     <- PathString(ctx.Request.Path.Value[webLog.ExtraPath.Length ..])
-            return! next.Invoke ctx
-        | None ->
-            if isDebug then log.LogDebug $"No resolved web log for {path}"
-            ctx.Response.StatusCode <- 404
-    }
-
-
-open System
-open Giraffe.Htmx
-
-/// Middleware to check redirects for the current web log
-type RedirectRuleMiddleware(next: RequestDelegate, _log: ILogger<RedirectRuleMiddleware>) =
-
-    /// Shorthand for case-insensitive string equality
-    let ciEquals str1 str2 =
-        String.Equals(str1, str2, StringComparison.InvariantCultureIgnoreCase)
-
-    member _.InvokeAsync(ctx: HttpContext) = task {
-        let path    = ctx.Request.Path.Value.ToLower()
-        let matched =
-            WebLogCache.redirectRules ctx.WebLog.Id
-            |> List.tryPick (fun rule ->
-                match rule with
-                | WebLogCache.CachedRedirectRule.Text (urlFrom, urlTo) ->
-                    if ciEquals path urlFrom then Some urlTo else None
-                | WebLogCache.CachedRedirectRule.RegEx (regExFrom, patternTo) ->
-                    if regExFrom.IsMatch path then Some (regExFrom.Replace(path, patternTo)) else None)
-        match matched with
-        | Some url when url.StartsWith "http" && ctx.Request.IsHtmx ->
-            do! ctx.Response.WriteAsync $"""<script>window.location.href = "{url}"</script>"""
-        | Some url -> ctx.Response.Redirect(url, permanent = true)
-        | None -> return! next.Invoke ctx
-    }
-
-
-open System.IO
-open BitBadger.Documents
-open Microsoft.Extensions.Configuration
-open Microsoft.Extensions.DependencyInjection
-open MyWebLog.Data
-open Newtonsoft.Json
-open Npgsql
-
-/// Logic to obtain a data connection and implementation based on configured values
-module DataImplementation =
-
-    open MyWebLog.Converters
-    open RethinkDb.Driver.FSharp
-    open RethinkDb.Driver.Net
-
-    /// Create an NpgsqlDataSource from the connection string, configuring appropriately
-    let createNpgsqlDataSource (cfg: IConfiguration) =
-        let builder = NpgsqlDataSourceBuilder(cfg.GetConnectionString "PostgreSQL")
-        let _ = builder.UseNodaTime()
-        // let _ = builder.UseLoggerFactory(LoggerFactory.Create(fun it -> it.AddConsole () |> ignore))
-        (builder.Build >> Postgres.Configuration.useDataSource) ()
-
-    /// Get the configured data implementation
-    let get (sp: IServiceProvider) : IData =
-        let config   = sp.GetRequiredService<IConfiguration>()
-        let await it = (Async.AwaitTask >> Async.RunSynchronously) it
-        let connStr    name = config.GetConnectionString name
-        let hasConnStr name = (connStr >> isNull >> not) name
-        let createSQLite connStr : IData =
-            Sqlite.Configuration.useConnectionString connStr
-            let log  = sp.GetRequiredService<ILogger<SQLiteData>>()
-            let conn = Sqlite.Configuration.dbConn ()
-            log.LogInformation $"Using SQLite database {conn.DataSource}"
-            SQLiteData(conn, log, Json.configure (JsonSerializer.CreateDefault()))
-
-        if hasConnStr "SQLite" then
-            createSQLite (connStr "SQLite")
-        elif hasConnStr "RethinkDB" then
-            let log        = sp.GetRequiredService<ILogger<RethinkDbData>>()
-            let _          = Json.configure Converter.Serializer
-            let rethinkCfg = DataConfig.FromUri (connStr "RethinkDB")
-            let conn       = await (rethinkCfg.CreateConnectionAsync log)
-            RethinkDbData(conn, rethinkCfg, log)
-        elif hasConnStr "PostgreSQL" then
-            createNpgsqlDataSource config
-            use conn = Postgres.Configuration.dataSource().CreateConnection()
-            let log  = sp.GetRequiredService<ILogger<PostgresData>>()
-            log.LogInformation $"Using PostgreSQL database {conn.Database}"
-            PostgresData(log, Json.configure (JsonSerializer.CreateDefault()))
-        else
-            if not (Directory.Exists "./data") then Directory.CreateDirectory "./data" |> ignore
-            createSQLite "Data Source=./data/myweblog.db;Cache=Shared"
-
-
-open System.Threading.Tasks
-
-/// Show a list of valid command-line interface commands
 let showHelp () =
     printfn " "
     printfn "COMMAND       WHAT IT DOES"
@@ -127,20 +14,30 @@ let showHelp () =
     printfn "upgrade-user  Upgrade a WebLogAdmin user to a full Administrator"
     printfn " "
     printfn "For more information on a particular command, run it with no options."
-    Task.FromResult()
+    System.Threading.Tasks.Task.FromResult()
 
 
-open BitBadger.AspNetCore.CanonicalDomains
+open System
-open Giraffe
+open System.IO
-open Giraffe.EndpointRouting
 open Microsoft.AspNetCore.Authentication.Cookies
 open Microsoft.AspNetCore.Builder
-open Microsoft.Extensions.Caching.Distributed
-open Microsoft.AspNetCore.HttpOverrides
 open Microsoft.AspNetCore.Hosting
+open Microsoft.AspNetCore.Http
+open Microsoft.AspNetCore.HttpOverrides
+open Microsoft.Extensions.Caching.Distributed
+open Microsoft.Extensions.Configuration
+open Microsoft.Extensions.DependencyInjection
 open Microsoft.Data.Sqlite
+open BitBadger.AspNetCore.CanonicalDomains
+open BitBadger.Documents
+open Giraffe
+open Giraffe.EndpointRouting
 open NeoSmart.Caching.Sqlite
+open Newtonsoft.Json
+open Npgsql
 open RethinkDB.DistributedCache
+open MyWebLog
+open MyWebLog.Data
 
 [<EntryPoint>]
 let main args =

src/MyWebLog/ProgramSupport.fs

@@ -0,0 +1,109 @@
+namespace MyWebLog
+
+open Microsoft.AspNetCore.Http
+open Microsoft.Extensions.Logging
+
+/// Middleware to derive the current web log
+type WebLogMiddleware(next: RequestDelegate, log: ILogger<WebLogMiddleware>) =
+
+    /// Is the debug level enabled on the logger?
+    let isDebug = log.IsEnabled LogLevel.Debug
+
+    member _.InvokeAsync(ctx: HttpContext) = task {
+        /// Create the full path of the request
+        let path = $"{ctx.Request.Scheme}://{ctx.Request.Host.Value}{ctx.Request.Path.Value}"
+        match WebLogCache.tryGet path with
+        | Some webLog ->
+            if isDebug then log.LogDebug $"Resolved web log {webLog.Id} for {path}"
+            ctx.Items["webLog"] <- webLog
+            if PageListCache.exists ctx then () else do! PageListCache.update ctx
+            if CategoryCache.exists ctx then () else do! CategoryCache.update ctx
+            if webLog.ExtraPath <> "" then
+                ctx.Request.PathBase <- PathString(webLog.ExtraPath)
+                ctx.Request.Path     <- PathString(ctx.Request.Path.Value[webLog.ExtraPath.Length ..])
+            return! next.Invoke ctx
+        | None ->
+            log.LogWarning $"No resolved web log for {path}"
+            ctx.Response.StatusCode <- 404
+    }
+
+
+open System
+open Giraffe.Htmx
+
+/// Middleware to check redirects for the current web log
+type RedirectRuleMiddleware(next: RequestDelegate, _log: ILogger<RedirectRuleMiddleware>) =
+
+    /// Shorthand for case-insensitive string equality
+    let ciEquals str1 str2 =
+        String.Equals(str1, str2, StringComparison.InvariantCultureIgnoreCase)
+
+    member _.InvokeAsync(ctx: HttpContext) = task {
+        let path    = ctx.Request.Path.Value.ToLower()
+        let matched =
+            WebLogCache.redirectRules ctx.WebLog.Id
+            |> List.tryPick (fun rule ->
+                match rule with
+                | WebLogCache.CachedRedirectRule.Text (urlFrom, urlTo) ->
+                    if ciEquals path urlFrom then Some urlTo else None
+                | WebLogCache.CachedRedirectRule.RegEx (regExFrom, patternTo) ->
+                    if regExFrom.IsMatch path then Some (regExFrom.Replace(path, patternTo)) else None)
+        match matched with
+        | Some url when url.StartsWith "http" && ctx.Request.IsHtmx ->
+            do! ctx.Response.WriteAsync $"""<script>window.location.href = "{url}"</script>"""
+        | Some url -> ctx.Response.Redirect(url, permanent = true)
+        | None -> return! next.Invoke ctx
+    }
+
+
+/// Logic to obtain a data connection and implementation based on configured values
+module DataImplementation =
+
+    open System.IO
+    open Microsoft.Extensions.Configuration
+    open Microsoft.Extensions.DependencyInjection
+    open BitBadger.Documents
+    open Newtonsoft.Json
+    open Npgsql
+    open RethinkDb.Driver.FSharp
+    open RethinkDb.Driver.Net
+    open MyWebLog.Data
+    open MyWebLog.Converters
+
+    /// Create an NpgsqlDataSource from the connection string, configuring appropriately
+    let createNpgsqlDataSource (cfg: IConfiguration) =
+        let builder = NpgsqlDataSourceBuilder(cfg.GetConnectionString "PostgreSQL")
+        let _ = builder.UseNodaTime()
+        // let _ = builder.UseLoggerFactory(LoggerFactory.Create(fun it -> it.AddConsole () |> ignore))
+        (builder.Build >> Postgres.Configuration.useDataSource) ()
+
+    /// Get the configured data implementation
+    let get (sp: IServiceProvider) : IData =
+        let config   = sp.GetRequiredService<IConfiguration>()
+        let await it = (Async.AwaitTask >> Async.RunSynchronously) it
+        let connStr    name = config.GetConnectionString name
+        let hasConnStr name = (connStr >> isNull >> not) name
+        let createSQLite connStr : IData =
+            Sqlite.Configuration.useConnectionString connStr
+            let log  = sp.GetRequiredService<ILogger<SQLiteData>>()
+            let conn = Sqlite.Configuration.dbConn ()
+            log.LogInformation $"Using SQLite database {conn.DataSource}"
+            SQLiteData(conn, log, Json.configure (JsonSerializer.CreateDefault()))
+
+        if hasConnStr "SQLite" then
+            createSQLite (connStr "SQLite")
+        elif hasConnStr "RethinkDB" then
+            let log        = sp.GetRequiredService<ILogger<RethinkDbData>>()
+            let _          = Json.configure Converter.Serializer
+            let rethinkCfg = DataConfig.FromUri (connStr "RethinkDB")
+            let conn       = await (rethinkCfg.CreateConnectionAsync log)
+            RethinkDbData(conn, rethinkCfg, log)
+        elif hasConnStr "PostgreSQL" then
+            createNpgsqlDataSource config
+            use conn = Postgres.Configuration.dataSource().CreateConnection()
+            let log  = sp.GetRequiredService<ILogger<PostgresData>>()
+            log.LogInformation $"Using PostgreSQL database {conn.Database}"
+            PostgresData(log, Json.configure (JsonSerializer.CreateDefault()))
+        else
+            if not (Directory.Exists "./data") then Directory.CreateDirectory "./data" |> ignore
+            createSQLite "Data Source=./data/myweblog.db;Cache=Shared"

src/MyWebLog/Views/WebLog.fs

@@ -701,8 +701,8 @@ let uploadNew app = [
 
 /// Web log settings page
 let webLogSettings
-        (model: SettingsModel) (themes: Theme list) (pages: Page list) (uploads: UploadDestination list)
+        (model: SettingsModel) (themes: Theme list) (pages: Page list) (htmxOpts: (string * string) list)
-        (rss: EditRssModel) (app: AppViewContext) = [
+        (uploads: UploadDestination list) (rss: EditRssModel) (app: AppViewContext) = [
     let feedDetail (feed: CustomFeed) =
         let source =
             match feed.Source with
@@ -786,7 +786,8 @@ let webLogSettings
                             textField [ _required ] (nameof model.TimeZone) "Time Zone" model.TimeZone []
                         ]
                         div [ _class "col-12 col-md-4 col-xl-2" ] [
-                            checkboxSwitch [] (nameof model.AutoHtmx) "Auto-Load htmx" model.AutoHtmx []
+                            selectField [ _required ] (nameof model.AutoHtmx) "Auto-Load htmx" model.AutoHtmx htmxOpts
+                                        fst snd []
                             span [ _class "form-text fst-italic" ] [
                                 a [ _href "https://htmx.org"; _target "_blank"; _relNoOpener ] [ raw "What is this?" ]
                             ]