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

Add category post counts

Browse Source 
- Add pagination (WIP)
- Tweak admin category/post list pages
This commit is contained in:
Daniel J. Summers 2022-04-27 20:01:33 -04:00
parent 6e7f4cc8ce
commit 5350c09484
15 changed files with 189 additions and 83 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

73
src/MyWebLog.Data/Data.fs
View File

@ -63,31 +63,39 @@ module Startup =
let! indexes = rethink<string list> { 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<int> {
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<Post list> {
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<Post list> {
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
}

2
src/MyWebLog.Data/MyWebLog.Data.fsproj
View File

@ -14,7 +14,7 @@
<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
<PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
<PackageReference Include="RethinkDb.Driver" Version="2.3.150" />
<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.8.0-alpha-0007" />
<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.8.0-alpha-0008" />
<PackageReference Update="FSharp.Core" Version="6.0.3" />
</ItemGroup>

2
src/MyWebLog.Domain/MyWebLog.Domain.fsproj
View File

@ -12,7 +12,7 @@
</ItemGroup>
<ItemGroup>
<PackageReference Include="Markdig" Version="0.28.1" />
<PackageReference Include="Markdig" Version="0.30.2" />
<PackageReference Update="FSharp.Core" Version="6.0.3" />
</ItemGroup>

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

@ -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
}

14
src/MyWebLog/Caches.fs
View File

@ -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<string, DisplayPage[]> ()
@ -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<IConnection> ()
let! cats = Data.Category.findAllForView webLog.id conn
_cache[Cache.makeKey ctx] <- cats
}
/// Cache for parsed templates

77
src/MyWebLog/Handlers.fs
View File

@ -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} &laquo; Posts"
| 1L, "posts" -> None
| _, "posts" -> Some $"Page {pageNbr}"
| _, _ -> Some $"Page {pageNbr} &laquo; 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

2
src/MyWebLog/MyWebLog.fsproj
View File

@ -14,7 +14,7 @@
</ItemGroup>
<ItemGroup>
<PackageReference Include="DotLiquid" Version="2.2.610" />
<PackageReference Include="DotLiquid" Version="2.2.614" />
<PackageReference Include="Giraffe" Version="6.0.0" />
<PackageReference Include="RethinkDB.DistributedCache" Version="0.9.0-alpha05" />
<PackageReference Update="FSharp.Core" Version="6.0.3" />

3
src/MyWebLog/Program.fs
View File

@ -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
}

2
src/MyWebLog/appsettings.json
View File

@ -1,7 +1,7 @@
{
"RethinkDB": {
"hostname": "data02.bitbadger.solutions",
"database": "myWebLog-dev"
"database": "myWebLog_dev"
},
"Generator": "myWebLog 2.0-alpha02"
}

31
src/MyWebLog/themes/admin/category-list.liquid
View File

@ -4,7 +4,6 @@
<table class="table table-sm table-hover">
<thead>
<tr>
<th scope="col">Actions</th>
<th scope="col">Category</th>
<th scope="col">Description</th>
</tr>
@ -12,22 +11,28 @@
<tbody>
{% for cat in categories -%}
<tr>
<td class="action-button-column">
<a class="btn btn-secondary btn-sm" href="/category/{{ cat.id }}/edit">Edit</a>
<a class="btn btn-danger btn-sm" href="/category/{{ cat.id }}/delete"
onclick="return Admin.deleteCategory('{{ cat.id }}', '{{ cat.name }}')">
Delete
</a>
</td>
<td>
<td class="no-wrap">
{%- if cat.parent_names %}
<small class="text-muted">{% for name in cat.parent_names %}{{ name }} &rang; {% endfor %}</small>
{% endif -%}
{{ cat.name }} &nbsp;
<small><a href="/posts/category/{{ cat.slug }}" target="_blank">View Posts</a></small>
{%- endif %}
{{ cat.name }}<br>
<small>
{%- if cat.post_count > 0 %}
<a href="/category/{{ cat.slug }}" target="_blank">
View {{ cat.post_count }} Post{% unless cat.post_count == 1 %}s{% endunless -%}
</a>
<span class="text-muted"> &bull; </span>
{%- endif %}
<a href="/category/{{ cat.id }}/edit">Edit</a>
<span class="text-muted"> &bull; </span>
<a href="/category/{{ cat.id }}/delete" class="text-danger"
onclick="return Admin.deleteCategory('{{ cat.id }}', '{{ cat.name }}')">
Delete
</a>
</small>
</td>
<td>
{%- if cat.description %}{{ cat.description.value }}{% else %}<em class="text-muted">none</em>{% endif -%}
{%- if cat.description %}{{ cat.description.value }}{% else %}<em class="text-muted">none</em>{% endif %}
</td>
</tr>
{%- endfor %}

21
src/MyWebLog/themes/admin/post-list.liquid
View File

@ -15,10 +15,9 @@
{% for post in model.posts -%}
<tr>
<td class="no-wrap">
{% 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 %}<br>
<small class="text-muted"><em>{{ post.updated_on | date: "MMMM d, yyyy" }}</em></small>
{%- endif %}
</td>
<td>
@ -38,4 +37,18 @@
{%- endfor %}
</tbody>
</table>
{% if model.newer_link or model.older_link %}
<div class="d-flex justify-content-evenly">
<div>
{% if model.newer_link %}
<p><a class="btn btn-default" href="/{{ model.newer_link.value }}">&laquo; Newer Posts</a></p>
{% endif %}
</div>
<div class="text-right">
{% if model.older_link %}
<p><a class="btn btn-default" href="/{{ model.older_link.value }}">Older Posts &raquo;</a></p>
{% endif %}
</div>
</div>
{% endif %}
</article>

5
src/MyWebLog/themes/daniel-j-summers/index.liquid
View File

@ -16,12 +16,12 @@
<nav aria-label="pagination">
<ul class="pager">
{% if model.newer_link -%}
<li class="previous item"><a href="/{{ model.newer_link }}">&laquo; Newer Posts</a></li>
<li class="previous item"><a href="/{{ model.newer_link.value }}">&laquo; Newer Posts</a></li>
{%- else -%}
<li></li>
{% endif %}
{% if model.older_link -%}
<li class="next item"><a href="/{{ model.older_link }}">Older Posts &raquo;</a></li>
<li class="next item"><a href="/{{ model.older_link.value }}">Older Posts &raquo;</a></li>
{%- endif -%}
</ul>
</nav>
@ -57,6 +57,7 @@
{%- assign indent = cat.parent_names | size -%}
<li class="cat-list-item"{% if indent > 0 %} style="padding-left:{{ indent }}rem;"{% endif %}>
<a href="/category/{{ cat.slug }}" class="cat-list-link">{{ cat.name }}</a>
<span class="cat-list-count">{{ cat.post_count }}</span>
</li>
{%- endfor %}
</ul>

8
src/MyWebLog/themes/daniel-j-summers/single-post.liquid
View File

@ -45,16 +45,16 @@
<ul class="pager">
{% if model.newer_link -%}
<li class="previous item">
<h4 class="item-heading"><a href="/{{ model.newer_link[0] }}">&ldquo;</a> Previous Post</h4>
<a href="/{{ model.newer_link[0] }}">&ldquo;{{ model.newer_link[1] }}&rdquo;</a>
<h4 class="item-heading"><a href="/{{ model.newer_link.value }}">&laquo;</a> Previous Post</h4>
<a href="/{{ model.newer_link.value }}">&ldquo;{{ model.newer_link.value }}&rdquo;</a>
</li>
{%- else -%}
<li></li>
{% endif %}
{% if model.older_link -%}
<li class="next item">
<h4 class="item-heading">Next Post <a href="/{{ model.older_link[0] }}">&rdquo;</a></h4>
<a href="/{{ model.older_link[0] }}">&ldquo;{{ model.older_link[1] }}&rdquo;</a>
<h4 class="item-heading">Next Post <a href="/{{ model.older_link.value }}">&raquo;</a></h4>
<a href="/{{ model.older_link.value }}">&ldquo;{{ model.older_link.value }}&rdquo;</a>
</li>
{%- endif -%}
</ul>

12
src/MyWebLog/wwwroot/themes/admin/admin.css
View File

@ -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;
}

6
src/MyWebLog/wwwroot/themes/daniel-j-summers/style.css
View File

@ -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 ----- */