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

Revise admin area with htmx

Browse Source 
- Replace tables with grids (much better on mobile)
- Category / tag mapping now edit inline
- Messages shown in all request forms
- Success messages auto-hide at 4 seconds
This commit is contained in:
Daniel J. Summers
2022-06-01 21:31:10 -04:00
parent 2a796042ac
commit c2b6d7c82c
19 changed files with 493 additions and 386 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -49,15 +49,28 @@ let dashboard : HttpHandler = fun next ctx -> task {
// GET /admin/categories
let listCategories : HttpHandler = fun next ctx -> task {
let! catListTemplate = TemplateCache.get "admin" "category-list-body"
let hash = Hash.FromAnonymousObject {|
web_log = ctx.WebLog
categories = CategoryCache.get ctx
page_title = "Categories"
csrf = csrfToken ctx
|}
hash.Add ("category_list", catListTemplate.Render hash)
return! viewForTheme "admin" "category-list" next ctx hash
}
// GET /admin/categories/bare
let listCategoriesBare : HttpHandler = fun next ctx -> task {
return!
Hash.FromAnonymousObject {|
categories = CategoryCache.get ctx
page_title = "Categories"
csrf = csrfToken ctx
|}
|> viewForTheme "admin" "category-list" next ctx
|> bareForTheme "admin" "category-list-body" next ctx
}
// GET /admin/category/{id}/edit
let editCategory catId : HttpHandler = fun next ctx -> task {
let! result = task {
@@ -77,7 +90,7 @@ let editCategory catId : HttpHandler = fun next ctx -> task {
page_title = title
categories = CategoryCache.get ctx
|}
|> viewForTheme "admin" "category-edit" next ctx
|> bareForTheme "admin" "category-edit" next ctx
| None -> return! Error.notFound next ctx
}
@@ -103,9 +116,7 @@ let saveCategory : HttpHandler = fun next ctx -> task {
do! (match model.categoryId with "new" -> Data.Category.add | _ -> Data.Category.update) cat conn
do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.success with message = "Category saved successfully" }
return!
redirectToGet (WebLog.relativeUrl webLog (Permalink $"admin/category/{CategoryId.toString cat.id}/edit"))
next ctx
return! listCategoriesBare next ctx
| None -> return! Error.notFound next ctx
}
@@ -117,7 +128,7 @@ let deleteCategory catId : HttpHandler = fun next ctx -> task {
do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.success with message = "Category deleted successfully" }
| false -> do! addMessage ctx { UserMessage.error with message = "Category not found; cannot delete" }
return! redirectToGet (WebLog.relativeUrl webLog (Permalink "admin/categories")) next ctx
return! listCategoriesBare next ctx
}
// -- PAGES --
@@ -304,20 +315,37 @@ let saveSettings : HttpHandler = fun next ctx -> task {
// -- TAG MAPPINGS --
// GET /admin/tag-mappings
let tagMappings : HttpHandler = fun next ctx -> task {
open Microsoft.AspNetCore.Http
/// Get the hash necessary to render the tag mapping list
let private tagMappingHash (ctx : HttpContext) = task {
let! mappings = Data.TagMap.findByWebLogId ctx.WebLog.id ctx.Conn
return!
Hash.FromAnonymousObject
{| csrf = csrfToken ctx
mappings = mappings
mapping_ids = mappings |> List.map (fun it -> { name = it.tag; value = TagMapId.toString it.id })
page_title = "Tag Mappings"
|}
|> viewForTheme "admin" "tag-mapping-list" next ctx
return Hash.FromAnonymousObject {|
web_log = ctx.WebLog
csrf = csrfToken ctx
mappings = mappings
mapping_ids = mappings |> List.map (fun it -> { name = it.tag; value = TagMapId.toString it.id })
|}
}
// GET /admin/tag-mapping/{id}/edit
// GET /admin/settings/tag-mappings
let tagMappings : HttpHandler = fun next ctx -> task {
let! hash = tagMappingHash ctx
let! listTemplate = TemplateCache.get "admin" "tag-mapping-list-body"
hash.Add ("tag_mapping_list", listTemplate.Render hash)
hash.Add ("page_title", "Tag Mappings")
return! viewForTheme "admin" "tag-mapping-list" next ctx hash
}
// GET /admin/settings/tag-mappings/bare
let tagMappingsBare : HttpHandler = fun next ctx -> task {
let! hash = tagMappingHash ctx
return! bareForTheme "admin" "tag-mapping-list-body" next ctx hash
}
// GET /admin/settings/tag-mapping/{id}/edit
let editMapping tagMapId : HttpHandler = fun next ctx -> task {
let isNew = tagMapId = "new"
let tagMap =
@@ -333,11 +361,11 @@ let editMapping tagMapId : HttpHandler = fun next ctx -> task {
model = EditTagMapModel.fromMapping tm
page_title = if isNew then "Add Tag Mapping" else $"Mapping for {tm.tag} Tag"
|}
|> viewForTheme "admin" "tag-mapping-edit" next ctx
|> bareForTheme "admin" "tag-mapping-edit" next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/tag-mapping/save
// POST /admin/settings/tag-mapping/save
let saveMapping : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let conn = ctx.Conn
@@ -351,17 +379,15 @@ let saveMapping : HttpHandler = fun next ctx -> task {
| Some tm ->
do! Data.TagMap.save { tm with tag = model.tag.ToLower (); urlValue = model.urlValue.ToLower () } conn
do! addMessage ctx { UserMessage.success with message = "Tag mapping saved successfully" }
return!
redirectToGet (WebLog.relativeUrl webLog (Permalink $"admin/tag-mapping/{TagMapId.toString tm.id}/edit"))
next ctx
return! tagMappingsBare next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/tag-mapping/{id}/delete
// POST /admin/settings/tag-mapping/{id}/delete
let deleteMapping tagMapId : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
match! Data.TagMap.delete (TagMapId tagMapId) webLog.id ctx.Conn with
| true -> do! addMessage ctx { UserMessage.success with message = "Tag mapping deleted successfully" }
| false -> do! addMessage ctx { UserMessage.error with message = "Tag mapping not found; nothing deleted" }
return! redirectToGet (WebLog.relativeUrl webLog (Permalink "admin/tag-mappings")) next ctx
return! tagMappingsBare next ctx
}

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

@@ -85,8 +85,8 @@ open Giraffe.ViewEngine
/// htmx script tag
let private htmxScript = RenderView.AsString.htmlNode Htmx.Script.minified
/// Render a view for the specified theme, using the specified template, layout, and hash
let viewForTheme theme template next ctx = fun (hash : Hash) -> task {
/// Populate the DotLiquid hash with standard information
let private populateHash hash ctx = task {
// Don't need the web log, but this adds it to the hash if the function is called directly
let _ = deriveWebLogFromHash hash ctx
let! messages = messages ctx
@@ -98,6 +98,11 @@ let viewForTheme theme template next ctx = fun (hash : Hash) -> task {
hash.Add ("htmx_script", htmxScript)
do! commitSession ctx
}
/// Render a view for the specified theme, using the specified template, layout, and hash
let viewForTheme theme template next ctx = fun (hash : Hash) -> task {
do! populateHash hash ctx
// 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
@@ -108,12 +113,38 @@ let viewForTheme theme template next ctx = fun (hash : Hash) -> task {
// ...then render that content with its layout
let isHtmx = ctx.Request.IsHtmx && not ctx.Request.IsHtmxRefresh
let layout = if isHtmx then "layout-partial" else "layout"
let! layoutTemplate = TemplateCache.get theme layout
let! layoutTemplate = TemplateCache.get theme (if isHtmx then "layout-partial" else "layout")
return! htmlString (layoutTemplate.Render hash) next ctx
}
/// Render a bare view for the specified theme, using the specified template and hash
let bareForTheme theme template next ctx = fun (hash : Hash) -> task {
do! populateHash hash ctx
// Bare templates are rendered with layout-bare
let! contentTemplate = TemplateCache.get theme template
hash.Add ("content", contentTemplate.Render hash)
let! layoutTemplate = TemplateCache.get theme "layout-bare"
// add messages as HTTP headers
let messages = hash["messages"] :?> UserMessage[]
let actions = seq {
yield!
messages
|> Array.map (fun m ->
match m.detail with
| Some detail -> $"{m.level}|||{m.message}|||{detail}"
| None -> $"{m.level}|||{m.message}"
|> setHttpHeader "X-Message")
withHxNoPush
htmlString (layoutTemplate.Render hash)
}
return! (actions |> Seq.reduce (>=>)) next ctx
}
/// Return a view for the web log's default theme
let themedView template next ctx = fun (hash : Hash) -> task {
return! viewForTheme (deriveWebLogFromHash hash ctx).themePath template next ctx hash

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

@@ -98,6 +98,7 @@ let router : HttpHandler = choose [
GET >=> choose [
subRoute "/categor" (choose [
route "ies" >=> Admin.listCategories
route "ies/bare" >=> Admin.listCategoriesBare
routef "y/%s/edit" Admin.editCategory
])
route "/dashboard" >=> Admin.dashboard
@@ -121,6 +122,7 @@ let router : HttpHandler = choose [
])
subRoute "/tag-mapping" (choose [
route "s" >=> Admin.tagMappings
route "s/bare" >=> Admin.tagMappingsBare
routef "/%s/edit" Admin.editMapping
])
])