V2 #1

Merged
danieljsummers merged 102 commits from v2 into main 2022-06-23 00:35:12 +00:00
14 changed files with 603 additions and 71 deletions
Showing only changes of commit a58cc25bbb - Show all commits

View File

@ -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<int> {
@ -137,6 +147,86 @@ module Category =
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<Category list> {
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<Category> {
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<Category list> {
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
module Page =
@ -295,6 +385,18 @@ module Post =
}
|> tryFirst
/// Find posts to be displayed on an admin page
let findPageOfPosts (webLogId : WebLogId) pageNbr postsPerPage =
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)
limit (postsPerPage + 1)
result; withRetryDefault
}
/// Find posts to be displayed on a page
let findPageOfPublishedPosts (webLogId : WebLogId) pageNbr postsPerPage =
rethink<Post list> {
@ -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
}
@ -375,3 +477,13 @@ module WebLogUser =
}
|> tryFirst
/// Get a user ID -> name dictionary for the given user IDs
let findNames (userIds : WebLogUserId list) (webLogId : WebLogId) conn = backgroundTask {
let! users = rethink<WebLogUser list> {
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
}

View File

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

View File

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

View File

@ -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
[<NoComparison; NoEquality>]
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
[<NoComparison; NoEquality>]
@ -40,17 +61,6 @@ type DisplayPage =
}
/// The model to use to allow a user to log on
[<CLIMutable; NoComparison; NoEquality>]
type LogOnModel =
{ /// The user's e-mail address
emailAddress : string
/// The user's password
password : string
}
/// The model used to display the admin dashboard
[<NoComparison; NoEquality>]
type DashboardModel =
@ -74,6 +84,35 @@ type DashboardModel =
}
/// View model for editing categories
[<CLIMutable; NoComparison; NoEquality>]
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
[<CLIMutable; NoComparison; NoEquality>]
type EditPageModel =
@ -114,6 +153,85 @@ type EditPageModel =
}
/// The model to use to allow a user to log on
[<CLIMutable; NoComparison; NoEquality>]
type LogOnModel =
{ /// The user's e-mail address
emailAddress : string
/// The user's password
password : string
}
/// View model for posts in a list
[<NoComparison; NoEquality>]
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<DateTime>
/// 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<string, string>
/// Author ID -> name lookup
authors : IDictionary<string, string>
/// 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
[<CLIMutable; NoComparison; NoEquality>]
type SettingsModel =

View File

@ -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<EditCategoryModel> ()
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<EditPageModel> ()
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

View File

@ -199,9 +199,13 @@ let main args =
Template.RegisterSafeType (typeof<WebLog>, all)
Template.RegisterSafeType (typeof<DashboardModel>, all)
Template.RegisterSafeType (typeof<DisplayCategory>, all)
Template.RegisterSafeType (typeof<DisplayPage>, all)
Template.RegisterSafeType (typeof<SettingsModel>, all)
Template.RegisterSafeType (typeof<EditCategoryModel>, all)
Template.RegisterSafeType (typeof<EditPageModel>, all)
Template.RegisterSafeType (typeof<PostDisplay>, all)
Template.RegisterSafeType (typeof<PostListItem>, all)
Template.RegisterSafeType (typeof<SettingsModel>, all)
Template.RegisterSafeType (typeof<UserMessage>, all)
Template.RegisterSafeType (typeof<AntiforgeryTokenSet>, all)

View File

@ -0,0 +1,56 @@
<h2 class="my-3">{{ page_title }}</h2>
<article>
<form action="/category/save" method="post">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<input type="hidden" name="categoryId" value="{{ model.category_id }}">
<div class="container">
<div class="row mb-3">
<div class="col-6 col-lg-4 pb-3">
<div class="form-floating">
<input type="text" name="name" id="name" class="form-control" placeholder="Name" autofocus required
value="{{ model.name }}">
<label for="name">Name</label>
</div>
</div>
<div class="col-6 col-lg-4 pb-3">
<div class="form-floating">
<input type="text" name="slug" id="slug" class="form-control" placeholder="Slug" required
value="{{ model.slug }}">
<label for="slug">Slug</label>
</div>
</div>
<div class="col-12 col-lg-4 pb-3">
<div class="form-floating">
<select name="parentId" id="parentId" class="form-control">
<option value=""{% if model.parent_id == "" %} selected="selected"{% endif %}>
&ndash; None &ndash;
</option>
{% for cat in categories -%}
{%- unless cat.id == model.category_id %}
<option value="{{ cat.id }}"{% if model.parent_id == cat.id %} selected="selected"{% endif %}>
{% for it in cat.parent_names %} &nbsp; &raquo; {% endfor %}{{ cat.name }}
</option>
{% endunless -%}
{%- endfor %}
</select>
<label for="parentId">Parent Category</label>
</div>
</div>
</div>
<div class="row mb-3">
<div class="col">
<div class="form-floating">
<input name="description" id="description" class="form-control"
placeholder="A short description of this category" value="{{ model.description }}">
<label for="description">Description</label>
</div>
</div>
</div>
<div class="row mb-3">
<div class="col">
<button type="submit" class="btn btn-primary">Save Changes</button>
</div>
</div>
</div>
</form>
</article>

View File

@ -0,0 +1,39 @@
<h2 class="my-3">{{ page_title }}</h2>
<article class="container">
<a href="/category/new/edit" class="btn btn-primary btn-sm mb-3">Add a New Category</a>
<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>
</thead>
<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>
{%- 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>
</td>
<td>
{%- if cat.description %}{{ cat.description.value }}{% else %}<em class="text-muted">none</em>{% endif -%}
</td>
</tr>
{%- endfor %}
</tbody>
</table>
<form method="post" id="deleteForm">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
</form>
</article>

View File

@ -9,7 +9,7 @@
Published <span class="badge rounded-pill bg-secondary">{{ model.posts }}</span>
&nbsp; Drafts <span class="badge rounded-pill bg-secondary">{{ model.drafts }}</span>
</h6>
<a href="/posts/list" class="btn btn-secondary me-2">View All</a>
<a href="/posts" class="btn btn-secondary me-2">View All</a>
<a href="/post/new/edit" class="btn btn-primary">Write a New Post</a>
</div>
</div>
@ -37,7 +37,7 @@
All <span class="badge rounded-pill bg-secondary">{{ model.categories }}</span>
&nbsp; Top Level <span class="badge rounded-pill bg-secondary">{{ model.top_level_categories }}</span>
</h6>
<a href="/categories/list" class="btn btn-secondary me-2">View All</a>
<a href="/categories" class="btn btn-secondary me-2">View All</a>
<a href="/category/new/edit" class="btn btn-secondary">Add a New Category</a>
</div>
</div>

View File

@ -63,5 +63,6 @@
<script src="https://cdn.jsdelivr.net/npm/bootstrap@5.0.2/dist/js/bootstrap.bundle.min.js"
integrity="sha384-MrcW6ZMFYlzcLA8Nl+NtUVF0sA7MsXsP1UyJoMp4YLEuNSfAP+JcXn/tWtIaxVXM"
crossorigin="anonymous"></script>
<script src="/themes/admin/admin.js"></script>
</body>
</html>

View File

@ -48,7 +48,7 @@
</div>
<div class="row mb-3">
<div class="col">
<textarea name="Text" id="text" class="form-control" rows="10">{{ model.text }}</textarea>
<textarea name="text" id="text" class="form-control" rows="10">{{ model.text }}</textarea>
</div>
</div>
<div class="row mb-3">

View File

@ -0,0 +1,41 @@
<h2 class="my-3">{{ page_title }}</h2>
<article class="container">
<a href="/post/new/edit" class="btn btn-primary btn-sm mb-3">Write a New Post</a>
<table class="table table-sm table-hover">
<thead>
<tr>
<th scope="col">Date</th>
<th scope="col">Title</th>
<th scope="col">Author</th>
<th scope="col">Status</th>
<th scope="col">Tags</th>
</tr>
</thead>
<tbody>
{% for post in model.posts -%}
<tr>
<td>
{% if post.published_on.has_value -%}
{{ post.published_on | date: "MMMM d, yyyy" }}
{%- else -%}
{{ post.updated_on | date: "MMMM d, yyyy" }}
{%- endif %}
</td>
<td>
{{ post.title }}<br>
<small>
<a href="/{{ post.permalink }}" target="_blank">View Post</a>
<span class="text-muted"> &bull; </span>
<a href="/post/{{ post.id }}/edit">Edit</a>
<span class="text-muted"> &bull; </span>
<a href="#" class="text-danger">Delete</a>
</small>
</td>
<td>{{ model.authors[post.author_id] }}</td>
<td>{{ post.status }}</td>
<td>{{ tags[post.id] }}</td>
</tr>
{%- endfor %}
</tbody>
</table>
</article>

View File

@ -7,3 +7,7 @@
max-width: 60rem;
margin: auto;
}
.action-button-column {
width: 1rem;
white-space: nowrap;
}

View File

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