bit-badger/myWebLog
1
0
Fork 0
Code Issues 2 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/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?" ]
]