Edit formatting for handlers

This commit is contained in:
2026-07-03 19:23:45 -04:00
parent 0de1bff190
commit 84444e4789
6 changed files with 1109 additions and 954 deletions
+263 -232
View File
@@ -97,6 +97,7 @@ let preparePostList webLog posts listType (url: string) pageNbr perPage (data: I
open Giraffe
// GET /page/{pageNbr}[/]
// (also served with pageNbr = 1 when default page is recent posts)
let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task {
if pageNbr <> 1 && ctx.Request.Path.Value.EndsWith "/" then
return! redirectTo true (ctx.WebLog.RelativeUrl(Permalink $"page/{pageNbr}")) next ctx
@@ -117,10 +118,6 @@ let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task {
|> themedView "index" next ctx
}
// GET /page/{pageNbr}/
let redirectToPageOfPosts (pageNbr: int) : HttpHandler = fun next ctx ->
redirectTo true (ctx.WebLog.RelativeUrl(Permalink $"page/{pageNbr}")) next ctx
// GET /category/{slug}/
// GET /category/{slug}/page/{pageNbr}
let pageOfCategorizedPosts slugAndPage : HttpHandler = fun next ctx -> task {
@@ -255,99 +252,114 @@ let chapters (post: Post) : HttpHandler = fun next ctx ->
// GET /admin/posts
// GET /admin/posts/page/{pageNbr}
let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data
let! posts = data.Post.FindPageOfPosts ctx.WebLog.Id pageNbr 25
let! viewCtx = preparePostList ctx.WebLog posts AdminList "" pageNbr 25 data
return! adminPage "Posts" next ctx (Post.list viewCtx.Posts)
}
let all pageNbr : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
let data = ctx.Data
let! posts = data.Post.FindPageOfPosts ctx.WebLog.Id pageNbr 25
let! viewCtx = preparePostList ctx.WebLog posts AdminList "" pageNbr 25 data
return! adminPage "Posts" next ctx (Post.list viewCtx.Posts)
}
// GET /admin/post/{id}/edit
let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data
let! result = task {
match postId with
| "new" -> return Some ("Write a New Post", { Post.Empty with Id = PostId "new" })
| _ ->
match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post -> return Some ("Edit Post", post)
| None -> return None
let edit postId : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
let data = ctx.Data
let! result = task {
match postId with
| "new" -> return Some ("Write a New Post", { Post.Empty with Id = PostId "new" })
| _ ->
match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post -> return Some ("Edit Post", post)
| None -> return None
}
match result with
| Some (title, post) when canEdit post.AuthorId ctx ->
let! templates = templatesForTheme ctx "post"
let model = EditPostModel.FromPost ctx.WebLog post
let ratings = [
{ Name = ""; Value = "&ndash; Default &ndash;" }
{ Name = string Yes; Value = "Yes" }
{ Name = string No; Value = "No" }
{ Name = string Clean; Value = "Clean" }
]
return! adminPage title next ctx (Post.postEdit model templates ratings)
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
match result with
| Some (title, post) when canEdit post.AuthorId ctx ->
let! templates = templatesForTheme ctx "post"
let model = EditPostModel.FromPost ctx.WebLog post
let ratings = [
{ Name = ""; Value = "&ndash; Default &ndash;" }
{ Name = string Yes; Value = "Yes" }
{ Name = string No; Value = "No" }
{ Name = string Clean; Value = "Clean" }
]
return! adminPage title next ctx (Post.postEdit model templates ratings)
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// DELETE /admin/post/{id}
let delete postId : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
match! ctx.Data.Post.Delete (PostId postId) ctx.WebLog.Id with
| true -> do! addMessage ctx { UserMessage.Success with Message = "Post deleted successfully" }
| false -> do! addMessage ctx { UserMessage.Error with Message = "Post not found; nothing deleted" }
//return! redirectToGet "admin/posts" next ctx
return! all 1 next ctx
}
let delete postId : HttpHandler =
requireAccess WebLogAdmin
>=> fun next ctx -> task {
match! ctx.Data.Post.Delete (PostId postId) ctx.WebLog.Id with
| true -> do! addMessage ctx { UserMessage.Success with Message = "Post deleted successfully" }
| false -> do! addMessage ctx { UserMessage.Error with Message = "Post not found; nothing deleted" }
//return! redirectToGet "admin/posts" next ctx
return! all 1 next ctx
}
// GET /admin/post/{id}/permalinks
let editPermalinks postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx ->
return!
ManagePermalinksModel.FromPost post
|> managePermalinks
|> adminPage "Manage Prior Permalinks" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
let editPermalinks postId : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx ->
return!
ManagePermalinksModel.FromPost post
|> managePermalinks
|> adminPage "Manage Prior Permalinks" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// POST /admin/post/permalinks
let savePermalinks : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<ManagePermalinksModel>()
let postId = PostId model.Id
match! ctx.Data.Post.FindById postId ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx ->
let links = model.Prior |> Array.map Permalink |> List.ofArray
match! ctx.Data.Post.UpdatePriorPermalinks postId ctx.WebLog.Id links with
| true ->
do! addMessage ctx { UserMessage.Success with Message = "Post permalinks saved successfully" }
return! redirectToGet $"admin/post/{model.Id}/permalinks" next ctx
| false -> return! Error.notFound next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
let savePermalinks : HttpHandler =
requireAccess Author
>=> validateCsrf
>=> fun next ctx -> task {
let! model = ctx.BindFormAsync<ManagePermalinksModel>()
let postId = PostId model.Id
match! ctx.Data.Post.FindById postId ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx ->
let links = model.Prior |> Array.map Permalink |> List.ofArray
match! ctx.Data.Post.UpdatePriorPermalinks postId ctx.WebLog.Id links with
| true ->
do! addMessage ctx { UserMessage.Success with Message = "Post permalinks saved successfully" }
return! redirectToGet $"admin/post/{model.Id}/permalinks" next ctx
| false -> return! Error.notFound next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// GET /admin/post/{id}/revisions
let editRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx ->
return!
ManageRevisionsModel.FromPost post
|> manageRevisions
|> adminPage "Manage Post Revisions" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
let editRevisions postId : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
match! ctx.Data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx ->
return!
ManageRevisionsModel.FromPost post
|> manageRevisions
|> adminPage "Manage Post Revisions" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
// DELETE /admin/post/{id}/revisions
let purgeRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data
match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx ->
do! data.Post.Update { post with Revisions = [ List.head post.Revisions ] }
do! addMessage ctx { UserMessage.Success with Message = "Prior revisions purged successfully" }
return! editRevisions postId next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
let purgeRevisions postId : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
let data = ctx.Data
match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post when canEdit post.AuthorId ctx ->
do! data.Post.Update { post with Revisions = [ List.head post.Revisions ] }
do! addMessage ctx { UserMessage.Success with Message = "Prior revisions purged successfully" }
return! editRevisions postId next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
open Microsoft.AspNetCore.Http
@@ -361,165 +373,184 @@ let private findPostRevision postId revDate (ctx: HttpContext) = task {
}
// GET /admin/post/{id}/revision/{revision-date}/preview
let previewRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPostRevision postId revDate ctx with
| Some post, Some rev when canEdit post.AuthorId ctx ->
return! adminBarePage "" next ctx (commonPreview rev)
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _ | _, None -> return! Error.notFound next ctx
}
let previewRevision (postId, revDate) : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
match! findPostRevision postId revDate ctx with
| Some post, Some rev when canEdit post.AuthorId ctx ->
return! adminBarePage "" next ctx (commonPreview rev)
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _ | _, None -> return! Error.notFound next ctx
}
// POST /admin/post/{id}/revision/{revision-date}/restore
let restoreRevision (postId, revDate) : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task {
match! findPostRevision postId revDate ctx with
| Some post, Some rev when canEdit post.AuthorId ctx ->
do! ctx.Data.Post.Update
{ post with
Revisions = { rev with AsOf = Noda.now () }
:: (post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf)) }
do! addMessage ctx { UserMessage.Success with Message = "Revision restored successfully" }
return! redirectToGet $"admin/post/{postId}/revisions" next ctx
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
let restoreRevision (postId, revDate) : HttpHandler =
requireAccess Author
>=> validateCsrf
>=> fun next ctx -> task {
match! findPostRevision postId revDate ctx with
| Some post, Some rev when canEdit post.AuthorId ctx ->
do! ctx.Data.Post.Update
{ post with
Revisions = { rev with AsOf = Noda.now () }
:: (post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf)) }
do! addMessage ctx { UserMessage.Success with Message = "Revision restored successfully" }
return! redirectToGet $"admin/post/{postId}/revisions" next ctx
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
// DELETE /admin/post/{id}/revision/{revision-date}
let deleteRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! findPostRevision postId revDate ctx with
| Some post, Some rev when canEdit post.AuthorId ctx ->
do! ctx.Data.Post.Update { post with Revisions = post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf) }
do! addMessage ctx { UserMessage.Success with Message = "Revision deleted successfully" }
return! adminBarePage "" next ctx (fun _ -> [])
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
let deleteRevision (postId, revDate) : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
match! findPostRevision postId revDate ctx with
| Some post, Some rev when canEdit post.AuthorId ctx ->
do! ctx.Data.Post.Update { post with Revisions = post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf) }
do! addMessage ctx { UserMessage.Success with Message = "Revision deleted successfully" }
return! adminBarePage "" next ctx (fun _ -> [])
| Some _, Some _ -> return! Error.notAuthorized next ctx
| None, _
| _, None -> return! Error.notFound next ctx
}
// GET /admin/post/{id}/chapters
let manageChapters postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.Post.FindById (PostId postId) ctx.WebLog.Id with
| Some post
when Option.isSome post.Episode
&& Option.isSome post.Episode.Value.Chapters
&& canEdit post.AuthorId ctx ->
return!
Post.chapters false (ManageChaptersModel.Create post)
|> adminPage "Manage Chapters" next ctx
| Some _ | None -> return! Error.notFound next ctx
}
let manageChapters postId : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
match! ctx.Data.Post.FindById (PostId postId) ctx.WebLog.Id with
| Some post
when Option.isSome post.Episode
&& Option.isSome post.Episode.Value.Chapters
&& canEdit post.AuthorId ctx ->
return!
Post.chapters false (ManageChaptersModel.Create post)
|> adminPage "Manage Chapters" next ctx
| Some _ | None -> return! Error.notFound next ctx
}
// GET /admin/post/{id}/chapter/{idx}
let editChapter (postId, index) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
match! ctx.Data.Post.FindById (PostId postId) ctx.WebLog.Id with
| Some post
when Option.isSome post.Episode
&& Option.isSome post.Episode.Value.Chapters
&& canEdit post.AuthorId ctx ->
let chapter =
if index = -1 then Some Chapter.Empty
else
let chapters = post.Episode.Value.Chapters.Value
if index < List.length chapters then Some chapters[index] else None
match chapter with
| Some chap ->
return!
Post.chapterEdit (EditChapterModel.FromChapter post.Id index chap)
|> adminBarePage (if index = -1 then "Add a Chapter" else "Edit Chapter") next ctx
| None -> return! Error.notFound next ctx
| Some _ | None -> return! Error.notFound next ctx
}
let editChapter (postId, index) : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
match! ctx.Data.Post.FindById (PostId postId) ctx.WebLog.Id with
| Some post
when Option.isSome post.Episode
&& Option.isSome post.Episode.Value.Chapters
&& canEdit post.AuthorId ctx ->
let chapter =
if index = -1 then Some Chapter.Empty
else
let chapters = post.Episode.Value.Chapters.Value
if index < List.length chapters then Some chapters[index] else None
match chapter with
| Some chap ->
return!
Post.chapterEdit (EditChapterModel.FromChapter post.Id index chap)
|> adminBarePage (if index = -1 then "Add a Chapter" else "Edit Chapter") next ctx
| None -> return! Error.notFound next ctx
| Some _ | None -> return! Error.notFound next ctx
}
// POST /admin/post/{id}/chapter/{idx}
let saveChapter (postId, index) : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task {
let data = ctx.Data
match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post
when Option.isSome post.Episode
&& Option.isSome post.Episode.Value.Chapters
&& canEdit post.AuthorId ctx ->
let! form = ctx.BindFormAsync<EditChapterModel>()
let chapters = post.Episode.Value.Chapters.Value
if index >= -1 && index < List.length chapters then
try
let chapter = form.ToChapter()
let existing = if index = -1 then chapters else List.removeAt index chapters
let updatedPost =
{ post with
Episode = Some
{ post.Episode.Value with
Chapters = Some (chapter :: existing |> List.sortBy _.StartTime) } }
do! data.Post.Update updatedPost
do! addMessage ctx { UserMessage.Success with Message = "Chapter saved successfully" }
return!
Post.chapterList form.AddAnother (ManageChaptersModel.Create updatedPost)
|> adminBarePage "Manage Chapters" next ctx
with
| ex -> return! Error.server ex.Message next ctx
else return! Error.notFound next ctx
| Some _ | None -> return! Error.notFound next ctx
}
let saveChapter (postId, index) : HttpHandler =
requireAccess Author
>=> validateCsrf
>=> fun next ctx -> task {
let data = ctx.Data
match! data.Post.FindFullById (PostId postId) ctx.WebLog.Id with
| Some post
when Option.isSome post.Episode
&& Option.isSome post.Episode.Value.Chapters
&& canEdit post.AuthorId ctx ->
let! form = ctx.BindFormAsync<EditChapterModel>()
let chapters = post.Episode.Value.Chapters.Value
if index >= -1 && index < List.length chapters then
try
let chapter = form.ToChapter()
let existing = if index = -1 then chapters else List.removeAt index chapters
let updatedPost =
{ post with
Episode = Some
{ post.Episode.Value with
Chapters = Some (chapter :: existing |> List.sortBy _.StartTime) } }
do! data.Post.Update updatedPost
do! addMessage ctx { UserMessage.Success with Message = "Chapter saved successfully" }
return!
Post.chapterList form.AddAnother (ManageChaptersModel.Create updatedPost)
|> adminBarePage "Manage Chapters" next ctx
with
| ex -> return! Error.server ex.Message next ctx
else return! Error.notFound next ctx
| Some _ | None -> return! Error.notFound next ctx
}
// DELETE /admin/post/{id}/chapter/{idx}
let deleteChapter (postId, index) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let data = ctx.Data
match! data.Post.FindById (PostId postId) ctx.WebLog.Id with
| Some post
when Option.isSome post.Episode
&& Option.isSome post.Episode.Value.Chapters
&& canEdit post.AuthorId ctx ->
let chapters = post.Episode.Value.Chapters.Value
if index >= 0 && index < List.length chapters then
let updatedPost =
{ post with
Episode = Some { post.Episode.Value with Chapters = Some (List.removeAt index chapters) } }
do! data.Post.Update updatedPost
do! addMessage ctx { UserMessage.Success with Message = "Chapter deleted successfully" }
return!
Post.chapterList false (ManageChaptersModel.Create updatedPost)
|> adminPage "Manage Chapters" next ctx
else return! Error.notFound next ctx
| Some _ | None -> return! Error.notFound next ctx
}
let deleteChapter (postId, index) : HttpHandler =
requireAccess Author
>=> fun next ctx -> task {
let data = ctx.Data
match! data.Post.FindById (PostId postId) ctx.WebLog.Id with
| Some post
when Option.isSome post.Episode
&& Option.isSome post.Episode.Value.Chapters
&& canEdit post.AuthorId ctx ->
let chapters = post.Episode.Value.Chapters.Value
if index >= 0 && index < List.length chapters then
let updatedPost =
{ post with
Episode = Some { post.Episode.Value with Chapters = Some (List.removeAt index chapters) } }
do! data.Post.Update updatedPost
do! addMessage ctx { UserMessage.Success with Message = "Chapter deleted successfully" }
return!
Post.chapterList false (ManageChaptersModel.Create updatedPost)
|> adminPage "Manage Chapters" next ctx
else return! Error.notFound next ctx
| Some _ | None -> return! Error.notFound next ctx
}
// POST /admin/post/save
let save : HttpHandler = requireAccess Author >=> validateCsrf >=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPostModel>()
let data = ctx.Data
let tryPost =
if model.IsNew then
{ Post.Empty with
Id = PostId.Create()
WebLogId = ctx.WebLog.Id
AuthorId = ctx.UserId }
|> someTask
else data.Post.FindFullById (PostId model.Id) ctx.WebLog.Id
match! tryPost with
| Some post when canEdit post.AuthorId ctx ->
let priorCats = post.CategoryIds
let updatedPost =
model.UpdatePost post (Noda.now ())
|> function
| post ->
if model.SetPublished then
let dt = parseToUtc (model.PubOverride.Value.ToString "o")
if model.SetUpdated then
{ post with
PublishedOn = Some dt
UpdatedOn = dt
Revisions = [ { (List.head post.Revisions) with AsOf = dt } ] }
else { post with PublishedOn = Some dt }
else post
do! (if model.IsNew then data.Post.Add else data.Post.Update) updatedPost
// If the post was published or its categories changed, refresh the category cache
if model.DoPublish
|| not (priorCats
|> List.append updatedPost.CategoryIds
|> List.distinct
|> List.length = List.length priorCats) then
do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.Success with Message = "Post saved successfully" }
return! redirectToGet $"admin/post/{post.Id}/edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}
let save : HttpHandler =
requireAccess Author
>=> validateCsrf
>=> fun next ctx -> task {
let! model = ctx.BindFormAsync<EditPostModel>()
let data = ctx.Data
let tryPost =
if model.IsNew then
{ Post.Empty with
Id = PostId.Create()
WebLogId = ctx.WebLog.Id
AuthorId = ctx.UserId }
|> someTask
else data.Post.FindFullById (PostId model.Id) ctx.WebLog.Id
match! tryPost with
| Some post when canEdit post.AuthorId ctx ->
let priorCats = post.CategoryIds
let updatedPost =
model.UpdatePost post (Noda.now ())
|> function
| post ->
if model.SetPublished then
let dt = parseToUtc (model.PubOverride.Value.ToString "o")
if model.SetUpdated then
{ post with
PublishedOn = Some dt
UpdatedOn = dt
Revisions = [ { (List.head post.Revisions) with AsOf = dt } ] }
else { post with PublishedOn = Some dt }
else post
do! (if model.IsNew then data.Post.Add else data.Post.Update) updatedPost
// If the post was published or its categories changed, refresh the category cache
if model.DoPublish
|| not (priorCats
|> List.append updatedPost.CategoryIds
|> List.distinct
|> List.length = List.length priorCats) then
do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.Success with Message = "Post saved successfully" }
return! redirectToGet $"admin/post/{post.Id}/edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}