diff --git a/src/MyWebLog.Data/Data.fs b/src/MyWebLog.Data/Data.fs index e6ed2bb..1d9fdc8 100644 --- a/src/MyWebLog.Data/Data.fs +++ b/src/MyWebLog.Data/Data.fs @@ -118,6 +118,16 @@ module Startup = /// Functions to manipulate categories module Category = + open MyWebLog.ViewModels + + /// Add a category + let add (cat : Category) = + rethink { + withTable Table.Category + insert cat + write; withRetryDefault; ignoreResult + } + /// Count all categories for a web log let countAll (webLogId : WebLogId) = rethink { @@ -136,6 +146,86 @@ module Category = count result; withRetryDefault } + + /// Create a category hierarchy from the given list of categories + let rec private orderByHierarchy (cats : Category list) parentId slugBase parentNames = seq { + for cat in cats |> List.filter (fun c -> c.parentId = parentId) do + let fullSlug = (match slugBase with Some it -> $"{it}/" | None -> "") + cat.slug + { id = CategoryId.toString cat.id + slug = fullSlug + name = cat.name + description = cat.description + parentNames = Array.ofList parentNames + } + yield! orderByHierarchy cats (Some cat.id) (Some fullSlug) ([ cat.name ] |> List.append parentNames) + } + + /// Find all categories for a web log, sorted alphabetically, arranged in groups, in view model format + let findAllForView (webLogId : WebLogId) conn = backgroundTask { + let! cats = rethink { + withTable Table.Category + getAll [ webLogId ] (nameof webLogId) + orderBy "name" + result; withRetryDefault conn + } + return orderByHierarchy cats None None [] |> Array.ofSeq + } + + /// Find a category by its ID + let findById (catId : CategoryId) webLogId = + rethink { + withTable Table.Category + get catId + resultOption; withRetryOptionDefault + } + |> verifyWebLog webLogId (fun c -> c.webLogId) + + /// Delete a category, also removing it from any posts to which it is assigned + let delete catId webLogId conn = backgroundTask { + match! findById catId webLogId conn with + | Some _ -> + // Delete the category off all posts where it is assigned + do! rethink { + 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) + write; withRetryDefault; ignoreResult conn + } + // Delete the category itself + do! rethink { + withTable Table.Category + get catId + delete + write; withRetryDefault; ignoreResult conn + } + return true + | None -> return false + } + + /// Get a category ID -> name dictionary for the given category IDs + let findNames (catIds : CategoryId list) (webLogId : WebLogId) conn = backgroundTask { + let! cats = rethink { + withTable Table.Category + getAll (catIds |> List.map (fun it -> it :> obj)) + filter "webLogId" webLogId + result; withRetryDefault conn + } + return cats |> List.map (fun c -> CategoryId.toString c.id, c.name) |> dict + } + + /// Update a category + let update (cat : Category) = + rethink { + withTable Table.Category + get cat.id + update [ "name", cat.name :> obj + "slug", cat.slug + "description", cat.description + "parentId", cat.parentId + ] + write; withRetryDefault; ignoreResult + } /// Functions to manipulate pages @@ -295,6 +385,18 @@ module Post = } |> tryFirst + /// Find posts to be displayed on an admin page + let findPageOfPosts (webLogId : WebLogId) pageNbr postsPerPage = + rethink { + withTable Table.Post + getAll [ webLogId ] (nameof webLogId) + without [ "priorPermalinks"; "revisions" ] + orderByFuncDescending (fun row -> row.G("publishedOn").Default_("updatedOn") :> obj) + skip ((pageNbr - 1) * postsPerPage) + limit (postsPerPage + 1) + result; withRetryDefault + } + /// Find posts to be displayed on a page let findPageOfPublishedPosts (webLogId : WebLogId) pageNbr postsPerPage = rethink { @@ -302,9 +404,9 @@ module Post = getAll [ webLogId ] (nameof webLogId) filter "status" Published without [ "priorPermalinks"; "revisions" ] - orderBy "publishedOn" + orderByDescending "publishedOn" skip ((pageNbr - 1) * postsPerPage) - limit postsPerPage + limit (postsPerPage + 1) result; withRetryDefault } @@ -374,4 +476,14 @@ module WebLogUser = result; withRetryDefault } |> tryFirst - \ No newline at end of file + + /// Get a user ID -> name dictionary for the given user IDs + let findNames (userIds : WebLogUserId list) (webLogId : WebLogId) conn = backgroundTask { + let! users = rethink { + withTable Table.WebLogUser + getAll (userIds |> List.map (fun it -> it :> obj)) + filter "webLogId" webLogId + result; withRetryDefault conn + } + return users |> List.map (fun u -> WebLogUserId.toString u.id, WebLogUser.displayName u) |> dict + } diff --git a/src/MyWebLog.Domain/DataTypes.fs b/src/MyWebLog.Domain/DataTypes.fs index 534cc64..27cb1a2 100644 --- a/src/MyWebLog.Domain/DataTypes.fs +++ b/src/MyWebLog.Domain/DataTypes.fs @@ -307,3 +307,10 @@ module WebLogUser = url = None authorizationLevel = User } + + /// Get the user's displayed name + let displayName user = + let name = + seq { match user.preferredName with "" -> user.firstName | n -> n; " "; user.lastName } + |> Seq.reduce (+) + name.Trim () diff --git a/src/MyWebLog.Domain/SupportTypes.fs b/src/MyWebLog.Domain/SupportTypes.fs index 3edee60..6476c3b 100644 --- a/src/MyWebLog.Domain/SupportTypes.fs +++ b/src/MyWebLog.Domain/SupportTypes.fs @@ -144,6 +144,12 @@ type PostStatus = /// The post is publicly viewable | Published +/// Functions to support post statuses +module PostStatus = + + /// Convert a post status to a string + let toString = function Draft -> "Draft" | Published -> "Published" + /// An identifier for a post type PostId = PostId of string diff --git a/src/MyWebLog.Domain/ViewModels.fs b/src/MyWebLog.Domain/ViewModels.fs index ab94c5d..be8d861 100644 --- a/src/MyWebLog.Domain/ViewModels.fs +++ b/src/MyWebLog.Domain/ViewModels.fs @@ -1,7 +1,28 @@ namespace MyWebLog.ViewModels -open MyWebLog open System +open System.Collections.Generic +open MyWebLog + +/// Details about a category, used to display category lists +[] +type DisplayCategory = + { /// The ID of the category + id : string + + /// The slug for the category + slug : string + + /// The name of the category + name : string + + /// A description of the category + description : string option + + /// The parent category names for this (sub)category + parentNames : string[] + } + /// Details about a page used to display page lists [] @@ -40,17 +61,6 @@ type DisplayPage = } -/// The model to use to allow a user to log on -[] -type LogOnModel = - { /// The user's e-mail address - emailAddress : string - - /// The user's password - password : string - } - - /// The model used to display the admin dashboard [] type DashboardModel = @@ -74,6 +84,35 @@ type DashboardModel = } +/// View model for editing categories +[] +type EditCategoryModel = + { /// The ID of the category being edited + categoryId : string + + /// The name of the category + name : string + + /// The category's URL slug + slug : string + + /// A description of the category (optional) + description : string + + /// The ID of the category for which this is a subcategory (optional) + parentId : string + } + + /// Create an edit model from an existing category + static member fromCategory (cat : Category) = + { categoryId = CategoryId.toString cat.id + name = cat.name + slug = cat.slug + description = defaultArg cat.description "" + parentId = cat.parentId |> Option.map CategoryId.toString |> Option.defaultValue "" + } + + /// View model to edit a page [] type EditPageModel = @@ -114,6 +153,85 @@ type EditPageModel = } +/// The model to use to allow a user to log on +[] +type LogOnModel = + { /// The user's e-mail address + emailAddress : string + + /// The user's password + password : string + } + + +/// View model for posts in a list +[] +type PostListItem = + { /// The ID of the post + id : string + + /// The ID of the user who authored the post + authorId : string + + /// The status of the post + status : string + + /// The title of the post + title : string + + /// The permalink for the post + permalink : string + + /// When this post was published + publishedOn : Nullable + + /// When this post was last updated + updatedOn : DateTime + + /// The text of the post + text : string + + /// The IDs of the categories for this post + categoryIds : string[] + + /// Tags for the post + tags : string[] + } + + /// Create a post list item from a post + static member fromPost (post : Post) = + { id = PostId.toString post.id + authorId = WebLogUserId.toString post.authorId + status = PostStatus.toString post.status + title = post.title + permalink = Permalink.toString post.permalink + publishedOn = Option.toNullable post.publishedOn + updatedOn = post.updatedOn + text = post.text + categoryIds = post.categoryIds |> List.map CategoryId.toString |> Array.ofList + tags = Array.ofList post.tags + } + + +/// View model for displaying posts +type PostDisplay = + { /// The posts to be displayed + posts : PostListItem[] + + /// Category ID -> name lookup + categories : IDictionary + + /// Author ID -> name lookup + authors : IDictionary + + /// Whether there are newer posts than the ones in this model + hasNewer : bool + + /// Whether there are older posts than the ones in this model + hasOlder : bool + } + + /// View model for editing web log settings [] type SettingsModel = diff --git a/src/MyWebLog/Handlers.fs b/src/MyWebLog/Handlers.fs index 6661b1a..06e4a8d 100644 --- a/src/MyWebLog/Handlers.fs +++ b/src/MyWebLog/Handlers.fs @@ -262,6 +262,77 @@ module Admin = } +/// Handlers to manipulate categories +module Category = + + // 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 |} + |> viewForTheme "admin" "category-list" next ctx + } + + // GET /category/{id}/edit + let edit catId : HttpHandler = requireUser >=> fun next ctx -> task { + let webLogId = webLogId ctx + let conn = conn ctx + let! result = task { + match catId with + | "new" -> return Some ("Add a New Category", { Category.empty with id = CategoryId "new" }) + | _ -> + match! Data.Category.findById (CategoryId catId) webLogId conn with + | Some cat -> return Some ("Edit Category", cat) + | None -> return None + } + let! allCats = Data.Category.findAllForView webLogId conn + match result with + | Some (title, cat) -> + return! + Hash.FromAnonymousObject {| + csrf = csrfToken ctx + model = EditCategoryModel.fromCategory cat + page_title = title + categories = allCats + |} + |> viewForTheme "admin" "category-edit" next ctx + | None -> return! Error.notFound next ctx + } + + // POST /category/save + let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task { + let! model = ctx.BindFormAsync () + let webLogId = webLogId ctx + let conn = conn ctx + let! category = task { + match model.categoryId with + | "new" -> return Some { Category.empty with id = CategoryId.create (); webLogId = webLogId } + | catId -> return! Data.Category.findById (CategoryId catId) webLogId conn + } + match category with + | Some cat -> + let cat = + { cat with + name = model.name + slug = model.slug + description = match model.description with "" -> None | it -> Some it + parentId = match model.parentId with "" -> None | it -> Some (CategoryId it) + } + do! (match model.categoryId with "new" -> Data.Category.add | _ -> Data.Category.update) cat conn + 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 + } + + // POST /category/{id}/delete + let delete catId : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task { + match! Data.Category.delete (CategoryId catId) (webLogId ctx) (conn ctx) with + | true -> 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 + } + + /// Handlers to manipulate pages module Page = @@ -301,7 +372,7 @@ module Page = | None -> return! Error.notFound next ctx } - // POST /page/{id}/edit + // POST /page/save let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task { let! model = ctx.BindFormAsync () let webLogId = webLogId ctx @@ -408,6 +479,44 @@ module Post = return! Error.notFound next ctx } + // GET /posts + // GET /posts/page/{pageNbr} + let all pageNbr : HttpHandler = requireUser >=> fun next ctx -> task { + let webLog = WebLogCache.get ctx + let conn = conn ctx + let! posts = Data.Post.findPageOfPosts webLog.id pageNbr 25 conn + let! authors = + Data.WebLogUser.findNames (posts |> List.map (fun p -> p.authorId) |> List.distinct) webLog.id conn + let! cats = + Data.Category.findNames (posts |> List.map (fun c -> c.categoryIds) |> List.concat |> List.distinct) + webLog.id conn + let tags = posts + |> List.map (fun p -> PostId.toString p.id, p.tags |> List.fold (fun t tag -> $"{t}, {tag}") "") + |> dict + let model = + { posts = posts |> Seq.ofList |> Seq.truncate 25 |> Seq.map PostListItem.fromPost |> Array.ofSeq + authors = authors + categories = cats + hasNewer = pageNbr <> 1 + hasOlder = posts |> List.length > webLog.postsPerPage + } + return! + Hash.FromAnonymousObject {| model = model; tags = tags; page_title = "Posts" |} + |> viewForTheme "admin" "post-list" next ctx + } + + // GET /post/{id}/edit + let edit _ : HttpHandler = requireUser >=> fun next ctx -> task { + // TODO: write handler + return! Error.notFound next ctx + } + + // POST /post/{id}/edit + let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task { + // TODO: write handler + return! Error.notFound next ctx + } + /// Handlers to manipulate users module User = @@ -482,6 +591,16 @@ let endpoints = [ route "/settings" Admin.saveSettings ] ] + subRoute "/categor" [ + GET [ + route "ies" Category.all + routef "y/%s/edit" Category.edit + ] + POST [ + route "y/save" Category.save + routef "y/%s/delete" Category.delete + ] + ] subRoute "/page" [ GET [ routef "/%d" Post.pageOfPosts @@ -493,6 +612,16 @@ let endpoints = [ route "/save" Page.save ] ] + subRoute "/post" [ + GET [ + routef "/%s/edit" Post.edit + route "s" (Post.all 1) + routef "s/page/%d" Post.all + ] + POST [ + route "/save" Post.save + ] + ] subRoute "/user" [ GET [ route "/log-on" User.logOn diff --git a/src/MyWebLog/Program.fs b/src/MyWebLog/Program.fs index 9da5569..15fe9e2 100644 --- a/src/MyWebLog/Program.fs +++ b/src/MyWebLog/Program.fs @@ -199,9 +199,13 @@ let main args = Template.RegisterSafeType (typeof, all) Template.RegisterSafeType (typeof, all) + Template.RegisterSafeType (typeof, all) Template.RegisterSafeType (typeof, all) - Template.RegisterSafeType (typeof, all) + Template.RegisterSafeType (typeof, all) Template.RegisterSafeType (typeof, all) + Template.RegisterSafeType (typeof, all) + Template.RegisterSafeType (typeof, all) + Template.RegisterSafeType (typeof, all) Template.RegisterSafeType (typeof, all) Template.RegisterSafeType (typeof, all) diff --git a/src/MyWebLog/themes/admin/category-edit.liquid b/src/MyWebLog/themes/admin/category-edit.liquid new file mode 100644 index 0000000..0e5cc26 --- /dev/null +++ b/src/MyWebLog/themes/admin/category-edit.liquid @@ -0,0 +1,56 @@ +

{{ page_title }}

+
+
+ + +
+
+
+
+ + +
+
+
+
+ + +
+
+
+
+ + +
+
+
+
+
+
+ + +
+
+
+
+
+ +
+
+
+
+
diff --git a/src/MyWebLog/themes/admin/category-list.liquid b/src/MyWebLog/themes/admin/category-list.liquid new file mode 100644 index 0000000..e172b14 --- /dev/null +++ b/src/MyWebLog/themes/admin/category-list.liquid @@ -0,0 +1,39 @@ +

{{ page_title }}

+
+ Add a New Category + + + + + + + + + + {% for cat in categories -%} + + + + + + {%- endfor %} + +
ActionsCategoryDescription
+ Edit + + Delete + + + {%- if cat.parent_names %} + {% for name in cat.parent_names %}{{ name }} ⟩ {% endfor %} + {% endif -%} + {{ cat.name }}   + View Posts + + {%- if cat.description %}{{ cat.description.value }}{% else %}none{% endif -%} +
+
+ +
+
diff --git a/src/MyWebLog/themes/admin/dashboard.liquid b/src/MyWebLog/themes/admin/dashboard.liquid index f110158..18b8c72 100644 --- a/src/MyWebLog/themes/admin/dashboard.liquid +++ b/src/MyWebLog/themes/admin/dashboard.liquid @@ -9,7 +9,7 @@ Published {{ model.posts }}   Drafts {{ model.drafts }} - View All + View All Write a New Post @@ -37,7 +37,7 @@ All {{ model.categories }}   Top Level {{ model.top_level_categories }} - View All + View All Add a New Category diff --git a/src/MyWebLog/themes/admin/layout.liquid b/src/MyWebLog/themes/admin/layout.liquid index 0a3876a..2e043d9 100644 --- a/src/MyWebLog/themes/admin/layout.liquid +++ b/src/MyWebLog/themes/admin/layout.liquid @@ -8,60 +8,61 @@ -
- +
+
+ {% if messages %} +
+ {% for msg in messages %} + + {% endfor %} +
+ {% endif %} + {{ content }} +
+
+
+
+
myWebLog
- - -
- {% if messages %} -
- {% for msg in messages %} - - {% endfor %} -
- {% endif %} - {{ content }} -
-
-
-
-
myWebLog
-
-
-
- +
+ + diff --git a/src/MyWebLog/themes/admin/page-edit.liquid b/src/MyWebLog/themes/admin/page-edit.liquid index 4df1661..c5eb1a1 100644 --- a/src/MyWebLog/themes/admin/page-edit.liquid +++ b/src/MyWebLog/themes/admin/page-edit.liquid @@ -48,7 +48,7 @@
- +
diff --git a/src/MyWebLog/themes/admin/post-list.liquid b/src/MyWebLog/themes/admin/post-list.liquid index e69de29..2a51cbf 100644 --- a/src/MyWebLog/themes/admin/post-list.liquid +++ b/src/MyWebLog/themes/admin/post-list.liquid @@ -0,0 +1,41 @@ +

{{ page_title }}

+
+ Write a New Post + + + + + + + + + + + + {% for post in model.posts -%} + + + + + + + + {%- endfor %} + +
DateTitleAuthorStatusTags
+ {% if post.published_on.has_value -%} + {{ post.published_on | date: "MMMM d, yyyy" }} + {%- else -%} + {{ post.updated_on | date: "MMMM d, yyyy" }} + {%- endif %} + + {{ post.title }}
+ + View Post + • + Edit + • + Delete + + 		{{ model.authors[post.author_id] }}{{ post.status }}{{ tags[post.id] }}
+
diff --git a/src/MyWebLog/wwwroot/themes/admin/admin.css b/src/MyWebLog/wwwroot/themes/admin/admin.css index e9237e7..c0dad3e 100644 --- a/src/MyWebLog/wwwroot/themes/admin/admin.css +++ b/src/MyWebLog/wwwroot/themes/admin/admin.css @@ -7,3 +7,7 @@ max-width: 60rem; margin: auto; } +.action-button-column { + width: 1rem; + white-space: nowrap; +} diff --git a/src/MyWebLog/wwwroot/themes/admin/admin.js b/src/MyWebLog/wwwroot/themes/admin/admin.js new file mode 100644 index 0000000..b030360 --- /dev/null +++ b/src/MyWebLog/wwwroot/themes/admin/admin.js @@ -0,0 +1,15 @@ +const Admin = { + /** + * Confirm and delete a category + * @param id The ID of the category to be deleted + * @param name The name of the category to be deleted + */ + deleteCategory(id, name) { + if (confirm(`Are you sure you want to delete the category "${name}"? This action cannot be undone.`)) { + const form = document.getElementById("deleteForm") + form.action = `/category/${id}/delete` + form.submit() + } + return false + } +}