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

WIP on theme admin page (#20)

Browse Source
This commit is contained in:
Daniel J. Summers 2022-07-22 21:19:19 -04:00
parent 4514c4864d
commit 81fe03b8f3
15 changed files with 162 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/MyWebLog.Data/Interfaces.fs
View File

@ -167,7 +167,7 @@ type ITagMapData =
/// Functions to manipulate themes
type IThemeData =
/// Retrieve all themes (except "admin")
/// Retrieve all themes (except "admin") (excluding the text of templates)
abstract member All : unit -> Task<Theme list>
/// Find a theme by its ID

10
src/MyWebLog.Data/RethinkDbData.fs
View File

@ -96,6 +96,10 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
let keyPrefix = $"^{ThemeId.toString themeId}/"
fun (row : Ast.ReqlExpr) -> row[nameof ThemeAsset.empty.Id].Match keyPrefix :> obj
/// Function to exclude template text from themes
let withoutTemplateText (row : Ast.ReqlExpr) : obj =
{| Templates = row[nameof Theme.empty.Templates].Without [| nameof ThemeTemplate.empty.Text |] |}
/// Ensure field indexes exist, as well as special indexes for selected tables
let ensureIndexes table fields = backgroundTask {
let! indexes = rethink<string list> { withTable table; indexList; result; withRetryOnce conn }
@ -711,7 +715,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.All () = rethink<Theme list> {
withTable Table.Theme
filter (fun row -> row[nameof Theme.empty.Id].Ne "admin" :> obj)
without [ nameof Theme.empty.Templates ]
merge withoutTemplateText
orderBy (nameof Theme.empty.Id)
result; withRetryDefault conn
}
@ -725,9 +729,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.FindByIdWithoutText themeId = rethink<Theme> {
withTable Table.Theme
get themeId
merge (fun row ->
{| Templates = row[nameof Theme.empty.Templates].Without [| nameof ThemeTemplate.empty.Text |]
|})
merge withoutTemplateText
resultOption; withRetryOptionDefault conn
}

4
src/MyWebLog.Data/SQLite/Helpers.fs
View File

@ -242,9 +242,9 @@ module Map =
}
/// Create a theme template from the current row in the given data reader
let toThemeTemplate rdr : ThemeTemplate =
let toThemeTemplate includeText rdr : ThemeTemplate =
{ Name = getString "name" rdr
Text = getString "template" rdr
Text = if includeText then getString "template" rdr else ""
}
/// Create an uploaded file from the current row in the given data reader

16
src/MyWebLog.Data/SQLite/SQLiteThemeData.fs
View File

@ -8,12 +8,22 @@ open MyWebLog.Data
/// SQLite myWebLog theme data implementation
type SQLiteThemeData (conn : SqliteConnection) =
/// Retrieve all themes (except 'admin'; excludes templates)
/// Retrieve all themes (except 'admin'; excludes template text)
let all () = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM theme WHERE id <> 'admin' ORDER BY id"
use! rdr = cmd.ExecuteReaderAsync ()
return toList Map.toTheme rdr
let themes = toList Map.toTheme rdr
do! rdr.CloseAsync ()
cmd.CommandText <- "SELECT name, theme_id FROM theme_template WHERE theme_id <> 'admin' ORDER BY name"
use! rdr = cmd.ExecuteReaderAsync ()
let mutable templates = []
while rdr.Read () do
templates <- (ThemeId (Map.getString "theme_id" rdr), Map.toThemeTemplate false rdr) :: templates
return
themes
|> List.map (fun t ->
{ t with Templates = templates |> List.filter (fun tt -> fst tt = t.Id) |> List.map snd })
}
/// Find a theme by its ID
@ -28,7 +38,7 @@ type SQLiteThemeData (conn : SqliteConnection) =
templateCmd.CommandText <- "SELECT * FROM theme_template WHERE theme_id = @id"
templateCmd.Parameters.Add cmd.Parameters["@id"] |> ignore
use! templateRdr = templateCmd.ExecuteReaderAsync ()
return Some { theme with Templates = toList Map.toThemeTemplate templateRdr }
return Some { theme with Templates = toList (Map.toThemeTemplate true) templateRdr }
else
return None
}

34
src/MyWebLog.Domain/ViewModels.fs
View File

@ -176,6 +176,40 @@ with
open System.IO
/// Information about a theme used for display
[<NoComparison; NoEquality>]
type DisplayTheme =
{ /// The ID / path slug of the theme
Id : string
/// The name of the theme
Name : string
/// The version of the theme
Version : string
/// How many templates are contained in the theme
TemplateCount : int
/// Whether the theme is in use by any web logs
IsInUse : bool
/// Whether the theme .zip file exists on the filesystem
IsOnDisk : bool
}
with
/// Create a display theme from a theme
static member fromTheme inUseFunc (theme : Theme) =
{ Id = ThemeId.toString theme.Id
Name = theme.Name
Version = theme.Version
TemplateCount = List.length theme.Templates
IsInUse = inUseFunc theme.Id
IsOnDisk = File.Exists $"{ThemeId.toString theme.Id}-theme.zip"
}
/// Information about an uploaded file used for display
[<NoComparison; NoEquality>]
type DisplayUpload =

10
src/MyWebLog/Caches.fs
View File

@ -86,6 +86,10 @@ module WebLogCache =
_cache <- webLogs
}
/// Is the given theme in use by any web logs?
let isThemeInUse themeId =
_cache |> List.exists (fun wl -> wl.ThemeId = themeId)
/// A cache of page information needed to display the page list in templates
module PageListCache =
@ -147,12 +151,12 @@ module TemplateCache =
let private hasInclude = Regex ("""{% include_template \"(.*)\" %}""", RegexOptions.None, TimeSpan.FromSeconds 2)
/// Get a template for the given theme and template name
let get (themeId : string) (templateName : string) (data : IData) = backgroundTask {
let templatePath = $"{themeId}/{templateName}"
let get (themeId : ThemeId) (templateName : string) (data : IData) = backgroundTask {
let templatePath = $"{ThemeId.toString themeId}/{templateName}"
match _cache.ContainsKey templatePath with
| true -> ()
| false ->
match! data.Theme.FindById (ThemeId themeId) with
match! data.Theme.FindById themeId with
| Some theme ->
let mutable text = (theme.Templates |> List.find (fun t -> t.Name = templateName)).Text
while hasInclude.IsMatch text do

10
src/MyWebLog/DotLiquidBespoke.fs
View File

@ -228,11 +228,11 @@ let register () =
typeof<RssOptions>; typeof<TagMap>; typeof<UploadDestination>; typeof<WebLog>
// View models
typeof<DashboardModel>; typeof<DisplayCategory>; typeof<DisplayCustomFeed>; typeof<DisplayPage>
typeof<DisplayRevision>; typeof<DisplayUpload>; typeof<DisplayUser>; typeof<EditCategoryModel>
typeof<EditCustomFeedModel>; typeof<EditMyInfoModel>; typeof<EditPageModel>; typeof<EditPostModel>
typeof<EditRssModel>; typeof<EditTagMapModel>; typeof<EditUserModel>; typeof<LogOnModel>
typeof<ManagePermalinksModel>; typeof<ManageRevisionsModel>; typeof<PostDisplay>; typeof<PostListItem>
typeof<SettingsModel>; typeof<UserMessage>
typeof<DisplayRevision>; typeof<DisplayTheme>; typeof<DisplayUpload>; typeof<DisplayUser>
typeof<EditCategoryModel>; typeof<EditCustomFeedModel>; typeof<EditMyInfoModel>; typeof<EditPageModel>
typeof<EditPostModel>; typeof<EditRssModel>; typeof<EditTagMapModel>; typeof<EditUserModel>
typeof<LogOnModel>; typeof<ManagePermalinksModel>; typeof<ManageRevisionsModel>; typeof<PostDisplay>
typeof<PostListItem>; typeof<SettingsModel>; typeof<UserMessage>
// Framework types
typeof<AntiforgeryTokenSet>; typeof<DateTime option>; typeof<int option>; typeof<KeyValuePair>
typeof<MetaItem list>; typeof<string list>; typeof<string option>; typeof<TagMap list>

17
src/MyWebLog/Handlers/Admin.fs
View File

@ -34,7 +34,7 @@ let dashboard : HttpHandler = requireAccess Author >=> fun next ctx -> task {
// GET /admin/categories
let listCategories : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! catListTemplate = TemplateCache.get "admin" "category-list-body" ctx.Data
let! catListTemplate = TemplateCache.get adminTheme "category-list-body" ctx.Data
let! hash =
hashForPage "Categories"
|> withAntiCsrf ctx
@ -122,7 +122,7 @@ let private tagMappingHash (ctx : HttpContext) = task {
// GET /admin/settings/tag-mappings
let tagMappings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! hash = tagMappingHash ctx
let! listTemplate = TemplateCache.get "admin" "tag-mapping-list-body" ctx.Data
let! listTemplate = TemplateCache.get adminTheme "tag-mapping-list-body" ctx.Data
return!
addToHash "tag_mapping_list" (listTemplate.Render hash) hash
|> adminView "tag-mapping-list" next ctx
@ -181,6 +181,19 @@ open System.IO.Compression
open System.Text.RegularExpressions
open MyWebLog.Data
// GET /admin/themes
let listThemes : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
let! themes = ctx.Data.Theme.All ()
let! bodyTemplate = TemplateCache.get adminTheme "theme-list-body" ctx.Data
let hash =
hashForPage "Theme Administration"
|> withAntiCsrf ctx
|> addToHash "themes" (themes |> List.map (DisplayTheme.fromTheme WebLogCache.isThemeInUse) |> Array.ofList)
return!
addToHash "theme_list" (bodyTemplate.Render hash) hash
|> adminView "theme-list" next ctx
}
// GET /admin/theme/update
let themeUpdatePage : HttpHandler = requireAccess Administrator >=> fun next ctx ->
hashForPage "Upload Theme"

18
src/MyWebLog/Handlers/Helpers.fs
View File

@ -221,16 +221,16 @@ let isHtmx (ctx : HttpContext) =
/// Render a view for the specified theme, using the specified template, layout, and hash
let viewForTheme themeId template next ctx (hash : Hash) = task {
let! hash = addViewContext ctx hash
let (ThemeId theme) = themeId
// NOTE: DotLiquid does not support {% render %} or {% include %} in its templates, so we will do a 2-pass render;
// the net effect is a "layout" capability similar to Razor or Pug
// Render view content...
let! contentTemplate = TemplateCache.get theme template ctx.Data
let! contentTemplate = TemplateCache.get themeId template ctx.Data
let _ = addToHash ViewContext.Content (contentTemplate.Render hash) hash
// ...then render that content with its layout
let! layoutTemplate = TemplateCache.get theme (if isHtmx ctx then "layout-partial" else "layout") ctx.Data
let! layoutTemplate = TemplateCache.get themeId (if isHtmx ctx then "layout-partial" else "layout") ctx.Data
return! htmlString (layoutTemplate.Render hash) next ctx
}
@ -252,14 +252,13 @@ let messagesToHeaders (messages : UserMessage array) : HttpHandler =
/// Render a bare view for the specified theme, using the specified template and hash
let bareForTheme themeId template next ctx (hash : Hash) = task {
let! hash = addViewContext ctx hash
let (ThemeId theme) = themeId
if not (hash.ContainsKey ViewContext.Content) then
let! contentTemplate = TemplateCache.get theme template ctx.Data
let! contentTemplate = TemplateCache.get themeId template ctx.Data
addToHash ViewContext.Content (contentTemplate.Render hash) hash |> ignore
// Bare templates are rendered with layout-bare
let! layoutTemplate = TemplateCache.get theme "layout-bare" ctx.Data
let! layoutTemplate = TemplateCache.get themeId "layout-bare" ctx.Data
return!
(messagesToHeaders (hash[ViewContext.Messages] :?> UserMessage[])
>=> htmlString (layoutTemplate.Render hash))
@ -272,13 +271,16 @@ let themedView template next ctx hash = task {
return! viewForTheme (hash[ViewContext.WebLog] :?> WebLog).ThemeId template next ctx hash
}
/// The ID for the admin theme
let adminTheme = ThemeId "admin"
/// Display a view for the admin theme
let adminView template =
viewForTheme (ThemeId "admin") template
viewForTheme adminTheme template
/// Display a bare view for the admin theme
let adminBareView template =
bareForTheme (ThemeId "admin") template
bareForTheme adminTheme template
/// Redirect after doing some action; commits session and issues a temporary redirect
let redirectToGet url : HttpHandler = fun _ ctx -> task {

5
src/MyWebLog/Handlers/Routes.fs
View File

@ -140,7 +140,10 @@ let router : HttpHandler = choose [
routef "/%s/edit" Admin.editMapping
])
])
route "/theme/update" >=> Admin.themeUpdatePage
subRoute "/theme" (choose [
route "s" >=> Admin.listThemes
route "/update" >=> Admin.themeUpdatePage
])
subRoute "/upload" (choose [
route "s" >=> Upload.list
route "/new" >=> Upload.showNew

2
src/MyWebLog/Handlers/User.fs
View File

@ -90,7 +90,7 @@ let private goAway : HttpHandler = RequestErrors.BAD_REQUEST "really?"
// GET /admin/users
let all : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! hash = userListHash ctx
let! tmpl = TemplateCache.get "admin" "user-list-body" ctx.Data
let! tmpl = TemplateCache.get adminTheme "user-list-body" ctx.Data
return!
addToHash "user_list" (tmpl.Render hash) hash
|> adminView "user-list" next ctx

15
src/admin-theme/_layout.liquid
View File

@ -7,23 +7,26 @@
<span class="navbar-toggler-icon"></span>
</button>
<div class="collapse navbar-collapse" id="navbarText">
{% if is_logged_on -%}
{%- if is_logged_on %}
<ul class="navbar-nav">
{{ "admin/dashboard" | nav_link: "Dashboard" }}
{% if is_author %}
{%- if is_author %}
{{ "admin/pages" | nav_link: "Pages" }}
{{ "admin/posts" | nav_link: "Posts" }}
{{ "admin/uploads" | nav_link: "Uploads" }}
{% endif %}
{% if is_web_log_admin %}
{%- endif %}
{%- if is_web_log_admin %}
{{ "admin/categories" | nav_link: "Categories" }}
{{ "admin/users" | nav_link: "Users" }}
{{ "admin/settings" | nav_link: "Settings" }}
{% endif %}
{%- endif %}
{%- if is_administrator %}
{{ "admin/themes" | nav_link: "Themes" }}
{%- endif %}
</ul>
{%- endif %}
<ul class="navbar-nav flex-grow-1 justify-content-end">
{% if is_logged_on -%}
{%- if is_logged_on %}
{{ "admin/user/my-info" | nav_link: "My Info" }}
<li class="nav-item">
<a class="nav-link" href="{{ "user/log-off" | relative_link }}" hx-boost="false">Log Off</a>

3
src/admin-theme/_theme-list-columns.liquid Normal file
View File

@ -0,0 +1,3 @@
{%- assign theme_col = "col-12 col-md-6" -%}
{%- assign slug_col = "d-none d-md-block col-md-3" -%}
{%- assign tmpl_col = "d-none d-md-block col-md-3" -%}

34
src/admin-theme/theme-list-body.liquid Normal file
View File

@ -0,0 +1,34 @@
<form method="post" id="themeList" class="container" hx-target="this" hx-swap="outerHTML show:window:top">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<div class="row mwl-table-detail" id="theme_new"></div>
{% include_template "_theme-list-columns" %}
{% for theme in themes -%}
<div class="row mwl-table-detail" id="theme_{{ theme.id }}">
<div class="{{ theme_col }} no-wrap">
{{ theme.name }}
{%- if theme.is_in_use %}
<span class="badge bg-primary ms-2">IN USE</span>
{%- endif %}
{%- unless theme.is_on_disk %}
<span class="badge bg-warning text-dark ms-2">NOT ON DISK</span>
{%- endunless %}<br>
<small>
<span class="text-muted">v{{ theme.version }}</span>
{% unless theme.is_in_use or theme.id == "default" %}
<span class="text-muted"> &bull; </span>
{%- assign theme_del_link = "admin/" | append: theme.id | append: "/delete" | relative_link -%}
<a href="{{ theme_del_link }}" hx-post="{{ theme_del_link }}" class="text-danger"
hx-confirm="Are you sure you want to delete the theme &ldquo;{{ theme.name }}&rdquo;? This action cannot be undone.">
Delete
</a>
{% endunless %}
<span class="d-md-none text-muted">
<br>Slug: {{ theme.id }} &bull; {{ theme.template_count }} Templates
</span>
</small>
</div>
<div class="{{ slug_col }}">{{ theme.id }}</div>
<div class="{{ tmpl_col }}">{{ theme.template_count }}</div>
</div>
{%- endfor %}
</form>

16
src/admin-theme/theme-list.liquid Normal file
View File

@ -0,0 +1,16 @@
<h2 class="my-3">{{ page_title }}</h2>
<article>
<a href="{{ "admin/theme/upload" | relative_link }}" class="btn btn-primary btn-sm mb-3"
hx-target="#theme_new">
Upload a New Theme
</a>
<div class="container">
{% include_template "_theme-list-columns" %}
<div class="row mwl-table-heading">
<div class="{{ theme_col }}">Theme</div>
<div class="{{ slug_col }} d-none d-md-inline-block">Slug</div>
<div class="{{ tmpl_col }} d-none d-md-inline-block">Templates</div>
</div>
</div>
{{ theme_list }}
</article>