Add category post counts

- Add pagination (WIP)
- Tweak admin category/post list pages

src/MyWebLog.Data/Data.fs

@@ -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
+        // Post needs index by category (used for counting posts)
-        if Table.WebLogUser = table && not (indexes |> List.contains "logOn") then
+        if Table.Post = table && not (indexes |> List.contains "categoryIds") then
-            log.LogInformation($"Creating index {table}.logOn...")
+            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)
+            orderByFuncDescending (fun row -> row.G("publishedOn").Default_ "updatedOn" :> obj)
-            skip ((pageNbr - 1) * postsPerPage)
+            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
         }

src/MyWebLog.Data/MyWebLog.Data.fsproj

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

src/MyWebLog.Domain/MyWebLog.Domain.fsproj

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

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
+        /// The link to view newer (more recent) posts
-        hasNewer : bool
+        newerLink : string option
         
-        /// Whether there are older posts than the ones in this model
+        /// The link to view older (less recent) posts
-        hasOlder : bool
+        olderLink : string option
     }
 
 

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<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
+    /// Update the cache with fresh data
-    let set ctx cats = _cache[Cache.makeKey ctx] <- cats
+    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

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,45 +458,64 @@ 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
+              newerLink  = newerLink
-              hasOlder   = List.length posts > perPage
+              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
+            | 1L, "posts" -> None
             | _,  "posts" -> Some $"Page {pageNbr}"
             | _,  _       -> Some $"Page {pageNbr} &laquo; Posts"
         match title with Some ttl -> hash.Add ("page_title", ttl) | None -> ()
@@ -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

src/MyWebLog/MyWebLog.fsproj

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

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
+                do! CategoryCache.update ctx
-                CategoryCache.set ctx cats
                 return! next.Invoke ctx
             | None -> ctx.Response.StatusCode <- 404
     }

src/MyWebLog/appsettings.json

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

src/MyWebLog/themes/admin/category-list.liquid

@@ -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">
+          <td class="no-wrap">
-            <a class="btn btn-secondary btn-sm" href="/category/{{ cat.id }}/edit">Edit</a>
+            {%- if cat.parent_names %}
-            <a class="btn btn-danger btn-sm" href="/category/{{ cat.id }}/delete"
+              <small class="text-muted">{% for name in cat.parent_names %}{{ name }} &rang; {% endfor %}</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.parent_names %}
+            {%- if cat.description %}{{ cat.description.value }}{% else %}<em class="text-muted">none</em>{% endif %}
-              <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>
-          </td>
-          <td>
-            {%- if cat.description %}{{ cat.description.value }}{% else %}<em class="text-muted">none</em>{% endif -%}
           </td>
         </tr>
       {%- endfor %}

src/MyWebLog/themes/admin/post-list.liquid

@@ -15,10 +15,9 @@
       {% for post in model.posts -%}
         <tr>
           <td class="no-wrap">
-            {% if post.published_on.has_value -%}
+            {% if post.published_on %}{{ post.published_on | date: "MMMM d, yyyy" }}{% else %}Not Published{% endif %}
-              {{ post.published_on | date: "MMMM d, yyyy" }}
+            {%- if post.published_on != post.updated_on %}<br>
-            {%- else -%}
+              <small class="text-muted"><em>{{ post.updated_on | date: "MMMM d, yyyy" }}</em></small>
-              {{ post.updated_on | date: "MMMM d, yyyy" }}
             {%- 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>

src/MyWebLog/themes/daniel-j-summers/index.liquid

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

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

@@ -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>
+            <h4 class="item-heading"><a href="/{{ model.newer_link.value }}">&laquo;</a> Previous Post</h4>
-            <a href="/{{ model.newer_link[0] }}">&ldquo;{{ model.newer_link[1] }}&rdquo;</a>
+            <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>
+            <h4 class="item-heading">Next Post <a href="/{{ model.older_link.value }}">&raquo;</a></h4>
-            <a href="/{{ model.older_link[0] }}">&ldquo;{{ model.older_link[1] }}&rdquo;</a>
+            <a href="/{{ model.older_link.value }}">&ldquo;{{ model.older_link.value }}&rdquo;</a>
           </li>
         {%- endif -%}
       </ul>

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

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