bit-badger/myWebLog
1
0
Fork 0
Code Issues 5 Pull Requests Packages Projects Releases 11 Activity

Implement htmax as auto-htmx selection (#59)

Browse Source 
- Move program support items to MyWebLog namespace
- Fix parameter ordering in some tests
This commit is contained in:
Daniel J. Summers
2026-07-05 21:28:58 -04:00
parent 9d2277ab32
commit fcd02ecbec
12 changed files with 213 additions and 153 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/MyWebLog.Data/RethinkDbData.fs
+2 -2
View File
@@ -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
+4 -4
View File
@@ -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>
src/MyWebLog.Tests/Data/ConvertersTests.fs
+16
View File
@@ -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
+5 -5
View File
@@ -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
+41 -10
View File
@@ -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
+4 -4
View File
@@ -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
+1 -1
View File
@@ -41,7 +41,7 @@
}
]
},
"AutoHtmx": true,
"AutoHtmx": "Yes",
"Uploads": "Database",
"RedirectRules": []
},
src/MyWebLog/Handlers/Admin.fs
+5
View File
@@ -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
+1
View File
@@ -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
+17 -120
View File
@@ -1,117 +1,4 @@
open Microsoft.AspNetCore.Http
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
/// 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 Giraffe
open Giraffe.EndpointRouting
open System
open System.IO
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
+109
View File
@@ -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
+4 -3
View File
@@ -701,8 +701,8 @@ let uploadNew app = [
/// Web log settings page
let webLogSettings
(model: SettingsModel) (themes: Theme list) (pages: Page list) (uploads: UploadDestination list)
(rss: EditRssModel) (app: AppViewContext) = [
(model: SettingsModel) (themes: Theme list) (pages: Page list) (htmxOpts: (string * string) list)
(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?" ]
]