From 5350c09484959d9914511e5c9c6ba8486778e7cb Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Wed, 27 Apr 2022 20:01:33 -0400 Subject: [PATCH] Add category post counts - Add pagination (WIP) - Tweak admin category/post list pages --- src/MyWebLog.Data/Data.fs | 73 ++++++++++++++---- src/MyWebLog.Data/MyWebLog.Data.fsproj | 2 +- src/MyWebLog.Domain/MyWebLog.Domain.fsproj | 2 +- src/MyWebLog.Domain/ViewModels.fs | 14 ++-- src/MyWebLog/Caches.fs | 14 +++- src/MyWebLog/Handlers.fs | 77 ++++++++++++------- src/MyWebLog/MyWebLog.fsproj | 2 +- src/MyWebLog/Program.fs | 3 +- src/MyWebLog/appsettings.json | 2 +- .../themes/admin/category-list.liquid | 31 ++++---- src/MyWebLog/themes/admin/post-list.liquid | 21 ++++- .../themes/daniel-j-summers/index.liquid | 5 +- .../daniel-j-summers/single-post.liquid | 8 +- src/MyWebLog/wwwroot/themes/admin/admin.css | 12 +++ .../wwwroot/themes/daniel-j-summers/style.css | 6 +- 15 files changed, 189 insertions(+), 83 deletions(-) diff --git a/src/MyWebLog.Data/Data.fs b/src/MyWebLog.Data/Data.fs index a3015c7..0feeefa 100644 --- a/src/MyWebLog.Data/Data.fs +++ b/src/MyWebLog.Data/Data.fs @@ -63,31 +63,39 @@ module Startup = let! indexes = rethink { withTable table; indexList; result; withRetryOnce conn } for field in fields do if not (indexes |> List.contains field) then - log.LogInformation($"Creating index {table}.{field}...") + log.LogInformation $"Creating index {table}.{field}..." do! rethink { withTable table; indexCreate field; write; withRetryOnce; ignoreResult conn } // Post and page need index by web log ID and permalink if [ Table.Page; Table.Post ] |> List.contains table then if not (indexes |> List.contains "permalink") then - log.LogInformation($"Creating index {table}.permalink...") + log.LogInformation $"Creating index {table}.permalink..." do! rethink { withTable table - indexCreate "permalink" (fun row -> r.Array(row.G "webLogId", row.G "permalink") :> obj) + indexCreate "permalink" (fun row -> r.Array (row.G "webLogId", row.G "permalink") :> obj) write; withRetryOnce; ignoreResult conn } // Prior permalinks are searched when a post or page permalink do not match the current URL if not (indexes |> List.contains "priorPermalinks") then - log.LogInformation($"Creating index {table}.priorPermalinks...") + log.LogInformation $"Creating index {table}.priorPermalinks..." do! rethink { withTable table indexCreate "priorPermalinks" [ Multi ] write; withRetryOnce; ignoreResult conn } - // Users log on with e-mail - if Table.WebLogUser = table && not (indexes |> List.contains "logOn") then - log.LogInformation($"Creating index {table}.logOn...") + // Post needs index by category (used for counting posts) + if Table.Post = table && not (indexes |> List.contains "categoryIds") then + log.LogInformation $"Creating index {table}.categoryIds..." do! rethink { withTable table - indexCreate "logOn" (fun row -> r.Array(row.G "webLogId", row.G "userName") :> obj) + indexCreate "categoryIds" [ Multi ] + write; withRetryOnce; ignoreResult conn + } + // Users log on with e-mail + if Table.WebLogUser = table && not (indexes |> List.contains "logOn") then + log.LogInformation $"Creating index {table}.logOn..." + do! rethink { + withTable table + indexCreate "logOn" (fun row -> r.Array (row.G "webLogId", row.G "userName") :> obj) write; withRetryOnce; ignoreResult conn } } @@ -118,6 +126,7 @@ module Startup = /// Functions to manipulate categories module Category = + open System.Threading.Tasks open MyWebLog.ViewModels /// Add a category @@ -156,6 +165,8 @@ module Category = name = cat.name description = cat.description parentNames = Array.ofList parentNames + // Post counts are filled on a second pass + postCount = 0 } yield! orderByHierarchy cats (Some cat.id) (Some fullSlug) ([ cat.name ] |> List.append parentNames) } @@ -168,7 +179,37 @@ module Category = orderBy "name" result; withRetryDefault conn } - return orderByHierarchy cats None None [] |> Array.ofSeq + let ordered = orderByHierarchy cats None None [] + let! counts = + ordered + |> Seq.map (fun it -> backgroundTask { + // Parent category post counts include posts in subcategories + let catIds = + ordered + |> Seq.filter (fun cat -> cat.parentNames |> Array.contains it.name) + |> Seq.map (fun cat -> cat.id :> obj) + |> Seq.append (Seq.singleton it.id) + |> List.ofSeq + let! count = rethink { + withTable Table.Post + getAll catIds "categoryIds" + filter "status" Published + count + result; withRetryDefault conn + } + return it.id, count + }) + |> Task.WhenAll + return + ordered + |> Seq.map (fun cat -> + { cat with + postCount = counts + |> Array.tryFind (fun c -> fst c = cat.id) + |> Option.map snd + |> Option.defaultValue 0 + }) + |> Array.ofSeq } /// Find a category by its ID @@ -189,7 +230,7 @@ module Category = withTable Table.Post getAll [ webLogId ] (nameof webLogId) filter (fun row -> row.G("categoryIds").Contains catId :> obj) - update (fun row -> r.HashMap("categoryIds", r.Array(row.G("categoryIds")).Remove catId) :> obj) + update (fun row -> r.HashMap ("categoryIds", r.Array(row.G "categoryIds").Remove catId) :> obj) write; withRetryDefault; ignoreResult conn } // Delete the category itself @@ -405,26 +446,28 @@ module Post = |> tryFirst /// Find posts to be displayed on an admin page - let findPageOfPosts (webLogId : WebLogId) pageNbr postsPerPage = + let findPageOfPosts (webLogId : WebLogId) (pageNbr : int64) postsPerPage = + let pg = int pageNbr rethink { withTable Table.Post getAll [ webLogId ] (nameof webLogId) without [ "priorPermalinks"; "revisions" ] - orderByFuncDescending (fun row -> row.G("publishedOn").Default_("updatedOn") :> obj) - skip ((pageNbr - 1) * postsPerPage) + orderByFuncDescending (fun row -> row.G("publishedOn").Default_ "updatedOn" :> obj) + skip ((pg - 1) * postsPerPage) limit (postsPerPage + 1) result; withRetryDefault } /// Find posts to be displayed on a page - let findPageOfPublishedPosts (webLogId : WebLogId) pageNbr postsPerPage = + let findPageOfPublishedPosts (webLogId : WebLogId) (pageNbr : int64) postsPerPage = + let pg = int pageNbr rethink { withTable Table.Post getAll [ webLogId ] (nameof webLogId) filter "status" Published without [ "priorPermalinks"; "revisions" ] orderByDescending "publishedOn" - skip ((pageNbr - 1) * postsPerPage) + skip ((pg - 1) * postsPerPage) limit (postsPerPage + 1) result; withRetryDefault } diff --git a/src/MyWebLog.Data/MyWebLog.Data.fsproj b/src/MyWebLog.Data/MyWebLog.Data.fsproj index 02b3260..ca2d46e 100644 --- a/src/MyWebLog.Data/MyWebLog.Data.fsproj +++ b/src/MyWebLog.Data/MyWebLog.Data.fsproj @@ -14,7 +14,7 @@ - + diff --git a/src/MyWebLog.Domain/MyWebLog.Domain.fsproj b/src/MyWebLog.Domain/MyWebLog.Domain.fsproj index d77d399..9366bbb 100644 --- a/src/MyWebLog.Domain/MyWebLog.Domain.fsproj +++ b/src/MyWebLog.Domain/MyWebLog.Domain.fsproj @@ -12,7 +12,7 @@ - + diff --git a/src/MyWebLog.Domain/ViewModels.fs b/src/MyWebLog.Domain/ViewModels.fs index 43f3823..18df515 100644 --- a/src/MyWebLog.Domain/ViewModels.fs +++ b/src/MyWebLog.Domain/ViewModels.fs @@ -20,6 +20,9 @@ type DisplayCategory = /// The parent category names for this (sub)category parentNames : string[] + + /// The number of posts in this category + postCount : int } @@ -333,17 +336,14 @@ type PostDisplay = /// Author ID -> name lookup authors : MetaItem list - /// Category ID -> name lookup - categories : MetaItem list - /// A subtitle for the page subtitle : string option - /// Whether there are newer posts than the ones in this model - hasNewer : bool + /// The link to view newer (more recent) posts + newerLink : string option - /// Whether there are older posts than the ones in this model - hasOlder : bool + /// The link to view older (less recent) posts + olderLink : string option } diff --git a/src/MyWebLog/Caches.fs b/src/MyWebLog/Caches.fs index dd886a3..23fd6dc 100644 --- a/src/MyWebLog/Caches.fs +++ b/src/MyWebLog/Caches.fs @@ -31,12 +31,13 @@ module WebLogCache = let set ctx webLog = _cache[Cache.makeKey ctx] <- webLog +open Microsoft.Extensions.DependencyInjection +open RethinkDb.Driver.Net + /// A cache of page information needed to display the page list in templates module PageListCache = - open Microsoft.Extensions.DependencyInjection open MyWebLog.ViewModels - open RethinkDb.Driver.Net /// Cache of displayed pages let private _cache = ConcurrentDictionary () @@ -64,8 +65,13 @@ module CategoryCache = /// Get the categories for the web log for this request let get ctx = _cache[Cache.makeKey ctx] - /// Set the categories for the current web log - let set ctx cats = _cache[Cache.makeKey ctx] <- cats + /// Update the cache with fresh data + let update ctx = backgroundTask { + let webLog = WebLogCache.get ctx + let conn = ctx.RequestServices.GetRequiredService () + let! cats = Data.Category.findAllForView webLog.id conn + _cache[Cache.makeKey ctx] <- cats + } /// Cache for parsed templates diff --git a/src/MyWebLog/Handlers.fs b/src/MyWebLog/Handlers.fs index 4980b26..2fff220 100644 --- a/src/MyWebLog/Handlers.fs +++ b/src/MyWebLog/Handlers.fs @@ -285,17 +285,14 @@ module Admin = /// Handlers to manipulate categories module Category = - /// Update the category cache with flattened category hierarchy - let private updateCategoryCache webLogId ctx conn = task { - let! cats = Data.Category.findAllForView webLogId conn - CategoryCache.set ctx cats - } - // GET /categories let all : HttpHandler = requireUser >=> fun next ctx -> task { - let! cats = Data.Category.findAllForView (webLogId ctx) (conn ctx) return! - Hash.FromAnonymousObject {| categories = cats; page_title = "Categories"; csrf = csrfToken ctx |} + Hash.FromAnonymousObject {| + categories = CategoryCache.get ctx + page_title = "Categories" + csrf = csrfToken ctx + |} |> viewForTheme "admin" "category-list" next ctx } @@ -344,7 +341,7 @@ module Category = parentId = if model.parentId = "" then None else Some (CategoryId model.parentId) } do! (match model.categoryId with "new" -> Data.Category.add | _ -> Data.Category.update) cat conn - do! updateCategoryCache webLogId ctx conn + do! CategoryCache.update ctx do! addMessage ctx { UserMessage.success with message = "Category saved successfully" } return! redirectToGet $"/category/{CategoryId.toString cat.id}/edit" next ctx | None -> return! Error.notFound next ctx @@ -356,7 +353,7 @@ module Category = let conn = conn ctx match! Data.Category.delete (CategoryId catId) webLogId conn with | true -> - do! updateCategoryCache webLogId ctx conn + 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 "/categories" next ctx @@ -461,47 +458,66 @@ module Page = /// Handlers to manipulate posts module Post = + /// The type of post list being prepared + type ListType = + | CategoryList + | TagList + | PostList + | SinglePost + | AdminList + /// Convert a list of posts into items ready to be displayed - let private preparePostList (webLog : WebLog) (posts : Post list) pageNbr perPage ctx conn = task { + let private preparePostList (webLog : WebLog) (posts : Post list) listType pageNbr perPage ctx conn = task { let! authors = posts |> List.map (fun p -> p.authorId) |> List.distinct |> Data.WebLogUser.findNames webLog.id conn - let! cats = - posts - |> List.map (fun c -> c.categoryIds) - |> List.concat - |> List.distinct - |> Data.Category.findNames webLog.id conn let postItems = posts |> Seq.ofList |> Seq.truncate perPage |> Seq.map (PostListItem.fromPost webLog) |> Array.ofSeq + let newerLink = + match listType, pageNbr with + | SinglePost, _ -> Some "TODO: retrieve prior post" + | _, 1L -> None + | PostList, 2L when webLog.defaultPage = "posts" -> Some "" + | PostList, _ -> Some $"page/{pageNbr - 1L}" + | CategoryList, _ -> Some "TODO" + | TagList, _ -> Some "TODO" + | AdminList, 2L -> Some "posts" + | AdminList, _ -> Some $"posts/page/{pageNbr - 1L}" + let olderLink = + match listType, List.length posts > perPage with + | SinglePost, _ -> Some "TODO: retrieve next post" + | _, false -> None + | PostList, true -> Some $"page/{pageNbr + 1L}" + | CategoryList, true -> Some $"category/TODO-slug-goes-here/page/{pageNbr + 1L}" + | TagList, true -> Some $"tag/TODO-slug-goes-here/page/{pageNbr + 1L}" + | AdminList, true -> Some $"posts/page/{pageNbr + 1L}" let model = { posts = postItems authors = authors - categories = cats subtitle = None - hasNewer = pageNbr <> 1 - hasOlder = List.length posts > perPage + newerLink = newerLink + olderLink = olderLink } return Hash.FromAnonymousObject {| model = model; categories = CategoryCache.get ctx |} } // GET /page/{pageNbr} - let pageOfPosts (pageNbr : int) : HttpHandler = fun next ctx -> task { + let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task { let webLog = WebLogCache.get ctx let conn = conn ctx let! posts = Data.Post.findPageOfPublishedPosts webLog.id pageNbr webLog.postsPerPage conn - let! hash = preparePostList webLog posts pageNbr webLog.postsPerPage ctx conn + let! hash = preparePostList webLog posts PostList pageNbr webLog.postsPerPage ctx conn let title = match pageNbr, webLog.defaultPage with - | 1, "posts" -> None - | _, "posts" -> Some $"Page {pageNbr}" - | _, _ -> Some $"Page {pageNbr} « Posts" + | 1L, "posts" -> None + | _, "posts" -> Some $"Page {pageNbr}" + | _, _ -> Some $"Page {pageNbr} « Posts" match title with Some ttl -> hash.Add ("page_title", ttl) | None -> () return! themedView "index" next ctx hash } @@ -528,7 +544,7 @@ module Post = // Current post match! Data.Post.findByPermalink permalink webLog.id conn with | Some post -> - let! model = preparePostList webLog [ post ] 1 1 ctx conn + let! model = preparePostList webLog [ post ] SinglePost 1 1 ctx conn model.Add ("page_title", post.title) return! themedView "single-post" next ctx model | None -> @@ -558,7 +574,7 @@ module Post = let webLog = WebLogCache.get ctx let conn = conn ctx let! posts = Data.Post.findPageOfPosts webLog.id pageNbr 25 conn - let! hash = preparePostList webLog posts pageNbr 25 ctx conn + let! hash = preparePostList webLog posts AdminList pageNbr 25 ctx conn hash.Add ("page_title", "Posts") return! viewForTheme "admin" "post-list" next ctx hash } @@ -653,6 +669,13 @@ module Post = | false -> { post with publishedOn = Some dt } | false -> post do! (match model.postId with "new" -> Data.Post.add | _ -> Data.Post.update) post conn + // If the post was published or its categories changed, refresh the category cache + if model.doPublish + || not (pst.Value.categoryIds + |> List.append post.categoryIds + |> List.distinct + |> List.length = List.length pst.Value.categoryIds) then + do! CategoryCache.update ctx do! addMessage ctx { UserMessage.success with message = "Post saved successfully" } return! redirectToGet $"/post/{PostId.toString post.id}/edit" next ctx | None -> return! Error.notFound next ctx diff --git a/src/MyWebLog/MyWebLog.fsproj b/src/MyWebLog/MyWebLog.fsproj index abe92f2..ffc5d3e 100644 --- a/src/MyWebLog/MyWebLog.fsproj +++ b/src/MyWebLog/MyWebLog.fsproj @@ -14,7 +14,7 @@ - + diff --git a/src/MyWebLog/Program.fs b/src/MyWebLog/Program.fs index e04b3e6..49ea0f1 100644 --- a/src/MyWebLog/Program.fs +++ b/src/MyWebLog/Program.fs @@ -17,8 +17,7 @@ type WebLogMiddleware (next : RequestDelegate) = | Some webLog -> WebLogCache.set ctx webLog do! PageListCache.update ctx - let! cats = Data.Category.findAllForView webLog.id conn - CategoryCache.set ctx cats + do! CategoryCache.update ctx return! next.Invoke ctx | None -> ctx.Response.StatusCode <- 404 } diff --git a/src/MyWebLog/appsettings.json b/src/MyWebLog/appsettings.json index 3ba3a03..2081e58 100644 --- a/src/MyWebLog/appsettings.json +++ b/src/MyWebLog/appsettings.json @@ -1,7 +1,7 @@ { "RethinkDB": { "hostname": "data02.bitbadger.solutions", - "database": "myWebLog-dev" + "database": "myWebLog_dev" }, "Generator": "myWebLog 2.0-alpha02" } diff --git a/src/MyWebLog/themes/admin/category-list.liquid b/src/MyWebLog/themes/admin/category-list.liquid index e172b14..797a788 100644 --- a/src/MyWebLog/themes/admin/category-list.liquid +++ b/src/MyWebLog/themes/admin/category-list.liquid @@ -4,7 +4,6 @@ - @@ -12,22 +11,28 @@ {% for cat in categories -%} - - {%- endfor %} diff --git a/src/MyWebLog/themes/admin/post-list.liquid b/src/MyWebLog/themes/admin/post-list.liquid index 6a33ec3..f8e8e1c 100644 --- a/src/MyWebLog/themes/admin/post-list.liquid +++ b/src/MyWebLog/themes/admin/post-list.liquid @@ -15,10 +15,9 @@ {% for post in model.posts -%}
Actions Category Description
- Edit - - Delete - - + {%- if cat.parent_names %} {% for name in cat.parent_names %}{{ name }} ⟩ {% endfor %} - {% endif -%} - {{ cat.name }}   - View Posts + {%- endif %} + {{ cat.name }}
+ + {%- if cat.post_count > 0 %} + + View {{ cat.post_count }} Post{% unless cat.post_count == 1 %}s{% endunless -%} + + • + {%- endif %} + Edit + • + + Delete + + 		- {%- if cat.description %}{{ cat.description.value }}{% else %}none{% endif -%} + {%- if cat.description %}{{ cat.description.value }}{% else %}none{% endif %}
- {% if post.published_on.has_value -%} - {{ post.published_on | date: "MMMM d, yyyy" }} - {%- else -%} - {{ post.updated_on | date: "MMMM d, yyyy" }} + {% if post.published_on %}{{ post.published_on | date: "MMMM d, yyyy" }}{% else %}Not Published{% endif %} + {%- if post.published_on != post.updated_on %}
+ {{ post.updated_on | date: "MMMM d, yyyy" }} {%- endif %} 		@@ -38,4 +37,18 @@ {%- endfor %}
+ {% if model.newer_link or model.older_link %} +
+
+ {% if model.newer_link %} +

« Newer Posts

+ {% endif %} +
+
+ {% if model.older_link %} +

Older Posts »

+ {% endif %} +
+
+ {% endif %} diff --git a/src/MyWebLog/themes/daniel-j-summers/index.liquid b/src/MyWebLog/themes/daniel-j-summers/index.liquid index e5f5afd..e7c5256 100644 --- a/src/MyWebLog/themes/daniel-j-summers/index.liquid +++ b/src/MyWebLog/themes/daniel-j-summers/index.liquid @@ -16,12 +16,12 @@ @@ -57,6 +57,7 @@ {%- assign indent = cat.parent_names | size -%}
  • 0 %} style="padding-left:{{ indent }}rem;"{% endif %}> {{ cat.name }} + {{ cat.post_count }}
    • {%- endfor %} diff --git a/src/MyWebLog/themes/daniel-j-summers/single-post.liquid b/src/MyWebLog/themes/daniel-j-summers/single-post.liquid index d3414fb..1864848 100644 --- a/src/MyWebLog/themes/daniel-j-summers/single-post.liquid +++ b/src/MyWebLog/themes/daniel-j-summers/single-post.liquid @@ -45,16 +45,16 @@ diff --git a/src/MyWebLog/wwwroot/themes/admin/admin.css b/src/MyWebLog/wwwroot/themes/admin/admin.css index be3e5e6..32cb332 100644 --- a/src/MyWebLog/wwwroot/themes/admin/admin.css +++ b/src/MyWebLog/wwwroot/themes/admin/admin.css @@ -27,3 +27,15 @@ textarea { .no-wrap { white-space: nowrap; } +a:link, a:visited { + text-decoration: none; +} +a:link:hover, a:visited:hover { + text-decoration: underline; +} +a.text-danger:link:hover, a.text-danger:visited:hover { + text-decoration: none; + background-color: var(--bs-danger); + border-radius: 0.25rem; + color: white !important; +} diff --git a/src/MyWebLog/wwwroot/themes/daniel-j-summers/style.css b/src/MyWebLog/wwwroot/themes/daniel-j-summers/style.css index c2b7d36..d256030 100644 --- a/src/MyWebLog/wwwroot/themes/daniel-j-summers/style.css +++ b/src/MyWebLog/wwwroot/themes/daniel-j-summers/style.css @@ -62,8 +62,12 @@ sup { sub { vertical-align: baseline; } -img { +.content img { max-width: 100%; + border-radius: 1rem; +} +.content img.flat { + border-radius: 0; } /* ----- SITE HEADER ----- */