From 0a21240984c4ba32ef67659c3129b69f60f33933 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Sat, 21 May 2022 00:07:16 -0400 Subject: [PATCH] Implement tag mapping - Move all admin functions to /admin URLs - Create Liquid filters for page/post edit, category/tag link - Update all themes to use these filters - Add delete for pages/posts - Move category/page functions to Admin module --- src/MyWebLog.Data/Converters.fs | 8 + src/MyWebLog.Data/Data.fs | 169 +++++++++-- src/MyWebLog.Domain/DataTypes.fs | 27 ++ src/MyWebLog.Domain/SupportTypes.fs | 16 ++ src/MyWebLog.Domain/ViewModels.fs | 24 ++ src/MyWebLog/Handlers/Admin.fs | 269 ++++++++++++++++++ src/MyWebLog/Handlers/Category.fs | 82 ------ src/MyWebLog/Handlers/Page.fs | 127 --------- src/MyWebLog/Handlers/Post.fs | 69 +++-- src/MyWebLog/Handlers/Routes.fs | 92 +++--- src/MyWebLog/Handlers/User.fs | 6 +- src/MyWebLog/MyWebLog.fsproj | 2 - src/MyWebLog/Program.fs | 47 ++- .../themes/admin/category-edit.liquid | 2 +- .../themes/admin/category-list.liquid | 8 +- src/MyWebLog/themes/admin/dashboard.liquid | 12 +- src/MyWebLog/themes/admin/layout.liquid | 9 +- src/MyWebLog/themes/admin/page-edit.liquid | 2 +- src/MyWebLog/themes/admin/page-list.liquid | 12 +- src/MyWebLog/themes/admin/permalinks.liquid | 4 +- src/MyWebLog/themes/admin/post-edit.liquid | 2 +- src/MyWebLog/themes/admin/post-list.liquid | 12 +- .../themes/admin/tag-mapping-edit.liquid | 35 +++ .../themes/admin/tag-mapping-list.liquid | 32 +++ src/MyWebLog/themes/admin/user-edit.liquid | 2 +- .../themes/bit-badger/home-page.liquid | 2 +- .../themes/bit-badger/single-page.liquid | 2 +- .../themes/bit-badger/solution-page.liquid | 2 +- .../themes/daniel-j-summers/index.liquid | 2 +- .../daniel-j-summers/single-post.liquid | 6 +- src/MyWebLog/themes/tech-blog/index.liquid | 8 +- src/MyWebLog/themes/tech-blog/layout.liquid | 2 +- .../themes/tech-blog/single-page.liquid | 2 +- .../themes/tech-blog/single-post.liquid | 13 +- src/MyWebLog/wwwroot/themes/admin/admin.js | 44 ++- 35 files changed, 796 insertions(+), 357 deletions(-) delete mode 100644 src/MyWebLog/Handlers/Category.fs delete mode 100644 src/MyWebLog/Handlers/Page.fs create mode 100644 src/MyWebLog/themes/admin/tag-mapping-edit.liquid create mode 100644 src/MyWebLog/themes/admin/tag-mapping-list.liquid diff --git a/src/MyWebLog.Data/Converters.fs b/src/MyWebLog.Data/Converters.fs index 4c38c45..e3a4e7c 100644 --- a/src/MyWebLog.Data/Converters.fs +++ b/src/MyWebLog.Data/Converters.fs @@ -48,6 +48,13 @@ type PostIdConverter () = override _.ReadJson (reader : JsonReader, _ : Type, _ : PostId, _ : bool, _ : JsonSerializer) = (string >> PostId) reader.Value +type TagMapIdConverter () = + inherit JsonConverter () + override _.WriteJson (writer : JsonWriter, value : TagMapId, _ : JsonSerializer) = + writer.WriteValue (TagMapId.toString value) + override _.ReadJson (reader : JsonReader, _ : Type, _ : TagMapId, _ : bool, _ : JsonSerializer) = + (string >> TagMapId) reader.Value + type WebLogIdConverter () = inherit JsonConverter () override _.WriteJson (writer : JsonWriter, value : WebLogId, _ : JsonSerializer) = @@ -74,6 +81,7 @@ let all () : JsonConverter seq = PermalinkConverter () PageIdConverter () PostIdConverter () + TagMapIdConverter () WebLogIdConverter () WebLogUserIdConverter () // Handles DUs with no associated data, as well as option fields diff --git a/src/MyWebLog.Data/Data.fs b/src/MyWebLog.Data/Data.fs index 7282b81..db3be7a 100644 --- a/src/MyWebLog.Data/Data.fs +++ b/src/MyWebLog.Data/Data.fs @@ -17,6 +17,9 @@ module Table = /// The post table let Post = "Post" + /// The tag map table + let TagMap = "TagMap" + /// The web log table let WebLog = "WebLog" @@ -24,7 +27,7 @@ module Table = let WebLogUser = "WebLogUser" /// A list of all tables - let all = [ Category; Comment; Page; Post; WebLog; WebLogUser ] + let all = [ Category; Comment; Page; Post; TagMap; WebLog; WebLogUser ] /// Functions to assist with retrieving data @@ -50,6 +53,9 @@ module Helpers = let! results = f conn return results |> List.tryHead } + + /// Cast a strongly-typed list to an object list + let objList<'T> (objects : 'T list) = objects |> List.map (fun it -> it :> obj) open RethinkDb.Driver.FSharp @@ -71,7 +77,7 @@ module Startup = 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["webLogId"], row["permalink"]) :> obj) write; withRetryOnce; ignoreResult conn } // Prior permalinks are searched when a post or page permalink do not match the current URL @@ -92,18 +98,34 @@ module Startup = indexCreate idx [ Multi ] write; withRetryOnce; ignoreResult conn } + // Tag mapping needs an index by web log ID and both tag and URL values + if Table.TagMap = table then + if not (indexes |> List.contains "webLogAndTag") then + log.LogInformation $"Creating index {table}.webLogAndTag..." + do! rethink { + withTable table + indexCreate "webLogAndTag" (fun row -> r.Array (row["webLogId"], row["tag"]) :> obj) + write; withRetryOnce; ignoreResult conn + } + if not (indexes |> List.contains "webLogAndUrl") then + log.LogInformation $"Creating index {table}.webLogAndUrl..." + do! rethink { + withTable table + indexCreate "webLogAndUrl" (fun row -> r.Array (row["webLogId"], row["urlValue"]) :> obj) + 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) + indexCreate "logOn" (fun row -> r.Array (row["webLogId"], row["userName"]) :> obj) write; withRetryOnce; ignoreResult conn } } /// Ensure all necessary tables and indexes exist - let ensureDb (config : DataConfig) (log : ILogger) conn = task { + let ensureDb (config : DataConfig) (log : ILogger) conn = backgroundTask { let! dbs = rethink { dbList; result; withRetryOnce conn } if not (dbs |> List.contains config.Database) then @@ -121,6 +143,7 @@ module Startup = do! makeIdx Table.Comment [ "postId" ] do! makeIdx Table.Page [ "webLogId"; "authorId" ] do! makeIdx Table.Post [ "webLogId"; "authorId" ] + do! makeIdx Table.TagMap [] do! makeIdx Table.WebLog [ "urlBase" ] do! makeIdx Table.WebLogUser [ "webLogId" ] } @@ -178,7 +201,7 @@ module Category = let! cats = rethink { withTable Table.Category getAll [ webLogId ] (nameof webLogId) - orderByFunc (fun it -> it.G("name").Downcase () :> obj) + orderByFunc (fun it -> it["name"].Downcase () :> obj) result; withRetryDefault conn } let ordered = orderByHierarchy cats None None [] @@ -232,8 +255,8 @@ module Category = 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) + filter (fun row -> row["categoryIds"].Contains catId :> obj) + update (fun row -> r.HashMap ("categoryIds", r.Array(row["categoryIds"]).Remove catId) :> obj) write; withRetryDefault; ignoreResult conn } // Delete the category itself @@ -251,7 +274,7 @@ module Category = let findNames (webLogId : WebLogId) conn (catIds : CategoryId list) = backgroundTask { let! cats = rethink { withTable Table.Category - getAll (catIds |> List.map (fun it -> it :> obj)) + getAll (objList catIds) filter "webLogId" webLogId result; withRetryDefault conn } @@ -275,6 +298,8 @@ module Category = /// Functions to manipulate pages module Page = + open RethinkDb.Driver.Model + /// Add a new page let add (page : Page) = rethink { @@ -302,6 +327,19 @@ module Page = result; withRetryDefault } + /// Delete a page + let delete (pageId : PageId) (webLogId : WebLogId) conn = backgroundTask { + let! result = + rethink { + withTable Table.Page + getAll [ pageId ] + filter (fun row -> row["webLogId"].Eq webLogId :> obj) + delete + write; withRetryDefault conn + } + return result.Deleted > 0UL + } + /// Retrieve all pages for a web log (excludes text, prior permalinks, and revisions) let findAll (webLogId : WebLogId) = rethink { @@ -342,10 +380,10 @@ module Page = |> tryFirst /// Find the current permalink for a page by a prior permalink - let findCurrentPermalink (permalink : Permalink) (webLogId : WebLogId) = + let findCurrentPermalink (permalinks : Permalink list) (webLogId : WebLogId) = rethink { withTable Table.Page - getAll [ permalink ] "priorPermalinks" + getAll (objList permalinks) "priorPermalinks" filter "webLogId" webLogId pluck [ "permalink" ] limit 1 @@ -370,7 +408,7 @@ module Page = withTable Table.Page getAll [ webLogId ] (nameof webLogId) without [ "priorPermalinks"; "revisions" ] - orderByFunc (fun row -> row.G("title").Downcase ()) + orderByFunc (fun row -> row["title"].Downcase ()) skip ((pageNbr - 1) * 25) limit 25 result; withRetryDefault @@ -396,7 +434,7 @@ module Page = } /// Update prior permalinks for a page - let updatePriorPermalinks pageId webLogId (permalinks : Permalink list) conn = task { + let updatePriorPermalinks pageId webLogId (permalinks : Permalink list) conn = backgroundTask { match! findById pageId webLogId conn with | Some _ -> do! rethink { @@ -414,6 +452,7 @@ module Page = module Post = open System + open RethinkDb.Driver.Model /// Add a post let add (post : Post) = @@ -433,11 +472,24 @@ module Post = result; withRetryDefault } + /// Delete a post + let delete (postId : PostId) (webLogId : WebLogId) conn = backgroundTask { + let! result = + rethink { + withTable Table.Post + getAll [ postId ] + filter (fun row -> row["webLogId"].Eq webLogId :> obj) + delete + write; withRetryDefault conn + } + return result.Deleted > 0UL + } + /// Find a post by its permalink let findByPermalink (permalink : Permalink) (webLogId : WebLogId) = rethink { withTable Table.Post - getAll [ r.Array(webLogId, permalink) ] (nameof permalink) + getAll [ r.Array (webLogId, permalink) ] (nameof permalink) without [ "priorPermalinks"; "revisions" ] limit 1 result; withRetryDefault @@ -454,10 +506,10 @@ module Post = |> verifyWebLog webLogId (fun p -> p.webLogId) /// Find the current permalink for a post by a prior permalink - let findCurrentPermalink (permalink : Permalink) (webLogId : WebLogId) = + let findCurrentPermalink (permalinks : Permalink list) (webLogId : WebLogId) = rethink { withTable Table.Post - getAll [ permalink ] "priorPermalinks" + getAll (objList permalinks) "priorPermalinks" filter "webLogId" webLogId pluck [ "permalink" ] limit 1 @@ -470,7 +522,7 @@ module Post = let pg = int pageNbr rethink { withTable Table.Post - getAll (catIds |> List.map (fun it -> it :> obj)) "categoryIds" + getAll (objList catIds) "categoryIds" filter "webLogId" webLogId filter "status" Published without [ "priorPermalinks"; "revisions" ] @@ -488,7 +540,7 @@ module Post = withTable Table.Post getAll [ webLogId ] (nameof webLogId) without [ "priorPermalinks"; "revisions" ] - orderByFuncDescending (fun row -> row.G("publishedOn").Default_ "updatedOn" :> obj) + orderByFuncDescending (fun row -> row["publishedOn"].Default_ "updatedOn" :> obj) skip ((pg - 1) * postsPerPage) limit (postsPerPage + 1) result; withRetryDefault @@ -529,7 +581,7 @@ module Post = rethink { withTable Table.Post getAll [ webLogId ] (nameof webLogId) - filter (fun row -> row.G("publishedOn").Lt publishedOn :> obj) + filter (fun row -> row["publishedOn"].Lt publishedOn :> obj) orderByDescending "publishedOn" limit 1 result; withRetryDefault @@ -539,7 +591,7 @@ module Post = rethink { withTable Table.Post getAll [ webLogId ] (nameof webLogId) - filter (fun row -> row.G("publishedOn").Gt publishedOn :> obj) + filter (fun row -> row["publishedOn"].Gt publishedOn :> obj) orderBy "publishedOn" limit 1 result; withRetryDefault @@ -558,7 +610,7 @@ module Post = } /// Update prior permalinks for a post - let updatePriorPermalinks (postId : PostId) webLogId (permalinks : Permalink list) conn = task { + let updatePriorPermalinks (postId : PostId) webLogId (permalinks : Permalink list) conn = backgroundTask { match! ( rethink { withTable Table.Post @@ -579,16 +631,79 @@ module Post = } +/// Functions to manipulate tag mappings +module TagMap = + + open RethinkDb.Driver.Model + + /// Delete a tag mapping + let delete (tagMapId : TagMapId) (webLogId : WebLogId) conn = backgroundTask { + let! result = + rethink { + withTable Table.TagMap + getAll [ tagMapId ] + filter (fun row -> row["webLogId"].Eq webLogId :> obj) + delete + write; withRetryDefault conn + } + return result.Deleted > 0UL + } + + /// Find a tag map by its ID + let findById (tagMapId : TagMapId) webLogId = + rethink { + withTable Table.TagMap + get tagMapId + resultOption; withRetryOptionDefault + } + |> verifyWebLog webLogId (fun tm -> tm.webLogId) + + /// Find a tag mapping via URL value for a given web log + let findByUrlValue (urlValue : string) (webLogId : WebLogId) = + rethink { + withTable Table.TagMap + getAll [ r.Array (webLogId, urlValue) ] "webLogAndUrl" + limit 1 + result; withRetryDefault + } + |> tryFirst + + /// Find all tag mappings for a web log + let findByWebLogId (webLogId : WebLogId) = + rethink { + withTable Table.TagMap + between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ())) [ Index "webLogAndTag" ] + orderBy "tag" + result; withRetryDefault + } + + /// Retrieve mappings for the specified tags + let findMappingForTags (tags : string list) (webLogId : WebLogId) = + rethink { + withTable Table.TagMap + getAll (tags |> List.map (fun tag -> r.Array (webLogId, tag) :> obj)) "webLogAndTag" + result; withRetryDefault + } + + /// Save a tag mapping + let save (tagMap : TagMap) = + rethink { + withTable Table.TagMap + get tagMap.id + replace tagMap + write; withRetryDefault; ignoreResult + } + + /// Functions to manipulate web logs module WebLog = /// Add a web log - let add (webLog : WebLog) = - rethink { - withTable Table.WebLog - insert webLog - write; withRetryOnce; ignoreResult - } + let add (webLog : WebLog) = rethink { + withTable Table.WebLog + insert webLog + write; withRetryOnce; ignoreResult + } /// Retrieve a web log by the URL base let findByHost (url : string) = @@ -651,7 +766,7 @@ module WebLogUser = let findNames (webLogId : WebLogId) conn (userIds : WebLogUserId list) = backgroundTask { let! users = rethink { withTable Table.WebLogUser - getAll (userIds |> List.map (fun it -> it :> obj)) + getAll (objList userIds) filter "webLogId" webLogId result; withRetryDefault conn } diff --git a/src/MyWebLog.Domain/DataTypes.fs b/src/MyWebLog.Domain/DataTypes.fs index 2f0b6c1..4624b7a 100644 --- a/src/MyWebLog.Domain/DataTypes.fs +++ b/src/MyWebLog.Domain/DataTypes.fs @@ -219,6 +219,33 @@ module Post = } +/// A mapping between a tag and its URL value, used to translate restricted characters (ex. "#1" -> "number-1") +type TagMap = + { /// The ID of this tag mapping + id : TagMapId + + /// The ID of the web log to which this tag mapping belongs + webLogId : WebLogId + + /// The tag which should be mapped to a different value in links + tag : string + + /// The value by which the tag should be linked + urlValue : string + } + +/// Functions to support tag mappings +module TagMap = + + /// An empty tag mapping + let empty = + { id = TagMapId.empty + webLogId = WebLogId.empty + tag = "" + urlValue = "" + } + + /// A web log [] type WebLog = diff --git a/src/MyWebLog.Domain/SupportTypes.fs b/src/MyWebLog.Domain/SupportTypes.fs index 9f3e67e..cad55bd 100644 --- a/src/MyWebLog.Domain/SupportTypes.fs +++ b/src/MyWebLog.Domain/SupportTypes.fs @@ -187,6 +187,22 @@ module PostId = let create () = PostId (newId ()) +/// An identifier for a tag mapping +type TagMapId = TagMapId of string + +/// Functions to support tag mapping IDs +module TagMapId = + + /// An empty tag mapping ID + let empty = TagMapId "" + + /// Convert a tag mapping ID to a string + let toString = function TagMapId tmi -> tmi + + /// Create a new tag mapping ID + let create () = TagMapId (newId ()) + + /// An identifier for a web log type WebLogId = WebLogId of string diff --git a/src/MyWebLog.Domain/ViewModels.fs b/src/MyWebLog.Domain/ViewModels.fs index ccbc837..b923065 100644 --- a/src/MyWebLog.Domain/ViewModels.fs +++ b/src/MyWebLog.Domain/ViewModels.fs @@ -255,6 +255,30 @@ type EditPostModel = } +/// View model to edit a tag mapping +[] +type EditTagMapModel = + { /// The ID of the tag mapping being edited + id : string + + /// The tag being mapped to a different link value + tag : string + + /// The link value for the tag + urlValue : string + } + + /// Whether this is a new tag mapping + member this.isNew = this.id = "new" + + /// Create an edit model from the tag mapping + static member fromMapping (tagMap : TagMap) : EditTagMapModel = + { id = TagMapId.toString tagMap.id + tag = tagMap.tag + urlValue = tagMap.urlValue + } + + /// View model to edit a user [] type EditUserModel = diff --git a/src/MyWebLog/Handlers/Admin.fs b/src/MyWebLog/Handlers/Admin.fs index 5fbd7ce..9afd336 100644 --- a/src/MyWebLog/Handlers/Admin.fs +++ b/src/MyWebLog/Handlers/Admin.fs @@ -45,6 +45,214 @@ let dashboard : HttpHandler = requireUser >=> fun next ctx -> task { |> viewForTheme "admin" "dashboard" next ctx } +// -- CATEGORIES -- + +// GET /admin/categories +let listCategories : HttpHandler = requireUser >=> fun next ctx -> task { + return! + Hash.FromAnonymousObject {| + categories = CategoryCache.get ctx + page_title = "Categories" + csrf = csrfToken ctx + |} + |> viewForTheme "admin" "category-list" next ctx +} + +// GET /admin/category/{id}/edit +let editCategory 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 + } + match result with + | Some (title, cat) -> + return! + Hash.FromAnonymousObject {| + csrf = csrfToken ctx + model = EditCategoryModel.fromCategory cat + page_title = title + categories = CategoryCache.get ctx + |} + |> viewForTheme "admin" "category-edit" next ctx + | None -> return! Error.notFound next ctx +} + +// POST /admin/category/save +let saveCategory : 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 = if model.description = "" then None else Some model.description + 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! CategoryCache.update ctx + do! addMessage ctx { UserMessage.success with message = "Category saved successfully" } + return! redirectToGet $"/admin/category/{CategoryId.toString cat.id}/edit" next ctx + | None -> return! Error.notFound next ctx +} + +// POST /admin/category/{id}/delete +let deleteCategory catId : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task { + let webLogId = webLogId ctx + let conn = conn ctx + match! Data.Category.delete (CategoryId catId) webLogId conn with + | true -> + 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 "/admin/categories" next ctx +} + +// -- PAGES -- + +// GET /admin/pages +// GET /admin/pages/page/{pageNbr} +let listPages pageNbr : HttpHandler = requireUser >=> fun next ctx -> task { + let webLog = WebLogCache.get ctx + let! pages = Data.Page.findPageOfPages webLog.id pageNbr (conn ctx) + return! + Hash.FromAnonymousObject + {| pages = pages |> List.map (DisplayPage.fromPageMinimal webLog) + page_title = "Pages" + |} + |> viewForTheme "admin" "page-list" next ctx +} + +// GET /admin/page/{id}/edit +let editPage pgId : HttpHandler = requireUser >=> fun next ctx -> task { + let! result = task { + match pgId with + | "new" -> return Some ("Add a New Page", { Page.empty with id = PageId "new" }) + | _ -> + match! Data.Page.findByFullId (PageId pgId) (webLogId ctx) (conn ctx) with + | Some page -> return Some ("Edit Page", page) + | None -> return None + } + match result with + | Some (title, page) -> + let model = EditPageModel.fromPage page + return! + Hash.FromAnonymousObject {| + csrf = csrfToken ctx + model = model + metadata = Array.zip model.metaNames model.metaValues + |> Array.mapi (fun idx (name, value) -> [| string idx; name; value |]) + page_title = title + templates = templatesForTheme ctx "page" + |} + |> viewForTheme "admin" "page-edit" next ctx + | None -> return! Error.notFound next ctx +} + +// GET /admin/page/{id}/permalinks +let editPagePermalinks pgId : HttpHandler = requireUser >=> fun next ctx -> task { + match! Data.Page.findByFullId (PageId pgId) (webLogId ctx) (conn ctx) with + | Some pg -> + return! + Hash.FromAnonymousObject {| + csrf = csrfToken ctx + model = ManagePermalinksModel.fromPage pg + page_title = $"Manage Prior Permalinks" + |} + |> viewForTheme "admin" "permalinks" next ctx + | None -> return! Error.notFound next ctx +} + +// POST /admin/page/permalinks +let savePagePermalinks : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task { + let! model = ctx.BindFormAsync () + let links = model.prior |> Array.map Permalink |> List.ofArray + match! Data.Page.updatePriorPermalinks (PageId model.id) (webLogId ctx) links (conn ctx) with + | true -> + do! addMessage ctx { UserMessage.success with message = "Page permalinks saved successfully" } + return! redirectToGet $"/admin/page/{model.id}/permalinks" next ctx + | false -> return! Error.notFound next ctx +} + +// POST /admin/page/{id}/delete +let deletePage pgId : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task { + match! Data.Page.delete (PageId pgId) (webLogId ctx) (conn ctx) with + | true -> do! addMessage ctx { UserMessage.success with message = "Page deleted successfully" } + | false -> do! addMessage ctx { UserMessage.error with message = "Page not found; nothing deleted" } + return! redirectToGet "/admin/pages" next ctx +} + +open System + +#nowarn "3511" + +// POST /page/save +let savePage : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task { + let! model = ctx.BindFormAsync () + let webLogId = webLogId ctx + let conn = conn ctx + let now = DateTime.UtcNow + let! pg = task { + match model.pageId with + | "new" -> + return Some + { Page.empty with + id = PageId.create () + webLogId = webLogId + authorId = userId ctx + publishedOn = now + } + | pgId -> return! Data.Page.findByFullId (PageId pgId) webLogId conn + } + match pg with + | Some page -> + let updateList = page.showInPageList <> model.isShownInPageList + let revision = { asOf = now; text = MarkupText.parse $"{model.source}: {model.text}" } + // Detect a permalink change, and add the prior one to the prior list + let page = + match Permalink.toString page.permalink with + | "" -> page + | link when link = model.permalink -> page + | _ -> { page with priorPermalinks = page.permalink :: page.priorPermalinks } + let page = + { page with + title = model.title + permalink = Permalink model.permalink + updatedOn = now + showInPageList = model.isShownInPageList + template = match model.template with "" -> None | tmpl -> Some tmpl + text = MarkupText.toHtml revision.text + metadata = Seq.zip model.metaNames model.metaValues + |> Seq.filter (fun it -> fst it > "") + |> Seq.map (fun it -> { name = fst it; value = snd it }) + |> Seq.sortBy (fun it -> $"{it.name.ToLower ()} {it.value.ToLower ()}") + |> List.ofSeq + revisions = match page.revisions |> List.tryHead with + | Some r when r.text = revision.text -> page.revisions + | _ -> revision :: page.revisions + } + do! (if model.pageId = "new" then Data.Page.add else Data.Page.update) page conn + if updateList then do! PageListCache.update ctx + do! addMessage ctx { UserMessage.success with message = "Page saved successfully" } + return! redirectToGet $"/admin/page/{PageId.toString page.id}/edit" next ctx + | None -> return! Error.notFound next ctx +} + +// -- WEB LOG SETTINGS -- + // GET /admin/settings let settings : HttpHandler = requireUser >=> fun next ctx -> task { let webLog = WebLogCache.get ctx @@ -93,3 +301,64 @@ let saveSettings : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx - | None -> return! Error.notFound next ctx } +// -- TAG MAPPINGS -- + +// GET /admin/tag-mappings +let tagMappings : HttpHandler = requireUser >=> fun next ctx -> task { + let! mappings = Data.TagMap.findByWebLogId (webLogId ctx) (conn ctx) + return! + Hash.FromAnonymousObject + {| csrf = csrfToken ctx + mappings = mappings + mapping_ids = mappings |> List.map (fun it -> { name = it.tag; value = TagMapId.toString it.id }) + page_title = "Tag Mappings" + |} + |> viewForTheme "admin" "tag-mapping-list" next ctx +} + +// GET /admin/tag-mapping/{id}/edit +let editMapping tagMapId : HttpHandler = requireUser >=> fun next ctx -> task { + let webLogId = webLogId ctx + let isNew = tagMapId = "new" + let tagMap = + if isNew then + Task.FromResult (Some { TagMap.empty with id = TagMapId "new" }) + else + Data.TagMap.findById (TagMapId tagMapId) webLogId (conn ctx) + match! tagMap with + | Some tm -> + return! + Hash.FromAnonymousObject + {| csrf = csrfToken ctx + model = EditTagMapModel.fromMapping tm + page_title = if isNew then "Add Tag Mapping" else $"Mapping for {tm.tag} Tag" + |} + |> viewForTheme "admin" "tag-mapping-edit" next ctx + | None -> return! Error.notFound next ctx +} + +// POST /admin/tag-mapping/save +let saveMapping : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task { + let webLogId = webLogId ctx + let conn = conn ctx + let! model = ctx.BindFormAsync () + let tagMap = + if model.id = "new" then + Task.FromResult (Some { TagMap.empty with id = TagMapId.create (); webLogId = webLogId }) + else + Data.TagMap.findById (TagMapId model.id) webLogId conn + match! tagMap with + | Some tm -> + do! Data.TagMap.save { tm with tag = model.tag.ToLower (); urlValue = model.urlValue.ToLower () } conn + do! addMessage ctx { UserMessage.success with message = "Tag mapping saved successfully" } + return! redirectToGet $"/admin/tag-mapping/{TagMapId.toString tm.id}/edit" next ctx + | None -> return! Error.notFound next ctx +} + +// POST /admin/tag-mapping/{id}/delete +let deleteMapping tagMapId : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task { + match! Data.TagMap.delete (TagMapId tagMapId) (webLogId ctx) (conn ctx) with + | true -> do! addMessage ctx { UserMessage.success with message = "Tag mapping deleted successfully" } + | false -> do! addMessage ctx { UserMessage.error with message = "Tag mapping not found; nothing deleted" } + return! redirectToGet "/admin/tag-mappings" next ctx +} diff --git a/src/MyWebLog/Handlers/Category.fs b/src/MyWebLog/Handlers/Category.fs deleted file mode 100644 index d0d8e73..0000000 --- a/src/MyWebLog/Handlers/Category.fs +++ /dev/null @@ -1,82 +0,0 @@ -/// Handlers to manipulate categories -module MyWebLog.Handlers.Category - -open DotLiquid -open Giraffe -open MyWebLog - -// GET /categories -let all : HttpHandler = requireUser >=> fun next ctx -> task { - return! - Hash.FromAnonymousObject {| - categories = CategoryCache.get ctx - page_title = "Categories" - csrf = csrfToken ctx - |} - |> viewForTheme "admin" "category-list" next ctx -} - -open MyWebLog.ViewModels - -// 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 - } - match result with - | Some (title, cat) -> - return! - Hash.FromAnonymousObject {| - csrf = csrfToken ctx - model = EditCategoryModel.fromCategory cat - page_title = title - categories = CategoryCache.get ctx - |} - |> 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 = if model.description = "" then None else Some model.description - 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! 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 -} - -// POST /category/{id}/delete -let delete catId : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task { - let webLogId = webLogId ctx - let conn = conn ctx - match! Data.Category.delete (CategoryId catId) webLogId conn with - | true -> - 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 -} diff --git a/src/MyWebLog/Handlers/Page.fs b/src/MyWebLog/Handlers/Page.fs deleted file mode 100644 index 1667768..0000000 --- a/src/MyWebLog/Handlers/Page.fs +++ /dev/null @@ -1,127 +0,0 @@ -/// Handlers to manipulate pages -module MyWebLog.Handlers.Page - -open DotLiquid -open Giraffe -open MyWebLog -open MyWebLog.ViewModels - -// GET /pages -// GET /pages/page/{pageNbr} -let all pageNbr : HttpHandler = requireUser >=> fun next ctx -> task { - let webLog = WebLogCache.get ctx - let! pages = Data.Page.findPageOfPages webLog.id pageNbr (conn ctx) - return! - Hash.FromAnonymousObject - {| pages = pages |> List.map (DisplayPage.fromPageMinimal webLog) - page_title = "Pages" - |} - |> viewForTheme "admin" "page-list" next ctx -} - -// GET /page/{id}/edit -let edit pgId : HttpHandler = requireUser >=> fun next ctx -> task { - let! result = task { - match pgId with - | "new" -> return Some ("Add a New Page", { Page.empty with id = PageId "new" }) - | _ -> - match! Data.Page.findByFullId (PageId pgId) (webLogId ctx) (conn ctx) with - | Some page -> return Some ("Edit Page", page) - | None -> return None - } - match result with - | Some (title, page) -> - let model = EditPageModel.fromPage page - return! - Hash.FromAnonymousObject {| - csrf = csrfToken ctx - model = model - metadata = Array.zip model.metaNames model.metaValues - |> Array.mapi (fun idx (name, value) -> [| string idx; name; value |]) - page_title = title - templates = templatesForTheme ctx "page" - |} - |> viewForTheme "admin" "page-edit" next ctx - | None -> return! Error.notFound next ctx -} - -// GET /page/{id}/permalinks -let editPermalinks pgId : HttpHandler = requireUser >=> fun next ctx -> task { - match! Data.Page.findByFullId (PageId pgId) (webLogId ctx) (conn ctx) with - | Some pg -> - return! - Hash.FromAnonymousObject {| - csrf = csrfToken ctx - model = ManagePermalinksModel.fromPage pg - page_title = $"Manage Prior Permalinks" - |} - |> viewForTheme "admin" "permalinks" next ctx - | None -> return! Error.notFound next ctx -} - -// POST /page/permalinks -let savePermalinks : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task { - let! model = ctx.BindFormAsync () - let links = model.prior |> Array.map Permalink |> List.ofArray - match! Data.Page.updatePriorPermalinks (PageId model.id) (webLogId ctx) links (conn ctx) with - | true -> - do! addMessage ctx { UserMessage.success with message = "Page permalinks saved successfully" } - return! redirectToGet $"/page/{model.id}/permalinks" next ctx - | false -> return! Error.notFound next ctx -} - -open System - -#nowarn "3511" - -// POST /page/save -let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task { - let! model = ctx.BindFormAsync () - let webLogId = webLogId ctx - let conn = conn ctx - let now = DateTime.UtcNow - let! pg = task { - match model.pageId with - | "new" -> - return Some - { Page.empty with - id = PageId.create () - webLogId = webLogId - authorId = userId ctx - publishedOn = now - } - | pgId -> return! Data.Page.findByFullId (PageId pgId) webLogId conn - } - match pg with - | Some page -> - let updateList = page.showInPageList <> model.isShownInPageList - let revision = { asOf = now; text = MarkupText.parse $"{model.source}: {model.text}" } - // Detect a permalink change, and add the prior one to the prior list - let page = - match Permalink.toString page.permalink with - | "" -> page - | link when link = model.permalink -> page - | _ -> { page with priorPermalinks = page.permalink :: page.priorPermalinks } - let page = - { page with - title = model.title - permalink = Permalink model.permalink - updatedOn = now - showInPageList = model.isShownInPageList - template = match model.template with "" -> None | tmpl -> Some tmpl - text = MarkupText.toHtml revision.text - metadata = Seq.zip model.metaNames model.metaValues - |> Seq.filter (fun it -> fst it > "") - |> Seq.map (fun it -> { name = fst it; value = snd it }) - |> Seq.sortBy (fun it -> $"{it.name.ToLower ()} {it.value.ToLower ()}") - |> List.ofSeq - revisions = match page.revisions |> List.tryHead with - | Some r when r.text = revision.text -> page.revisions - | _ -> revision :: page.revisions - } - do! (if model.pageId = "new" then Data.Page.add else Data.Page.update) page conn - if updateList then do! PageListCache.update ctx - do! addMessage ctx { UserMessage.success with message = "Page saved successfully" } - return! redirectToGet $"/page/{PageId.toString page.id}/edit" next ctx - | None -> return! Error.notFound next ctx -} diff --git a/src/MyWebLog/Handlers/Post.fs b/src/MyWebLog/Handlers/Post.fs index c6912bd..fe039ff 100644 --- a/src/MyWebLog/Handlers/Post.fs +++ b/src/MyWebLog/Handlers/Post.fs @@ -34,13 +34,22 @@ let private getAuthors (webLog : WebLog) (posts : Post list) conn = |> List.distinct |> Data.WebLogUser.findNames webLog.id conn +/// Get all tag mappings for a list of posts as metadata items +let private getTagMappings (webLog : WebLog) (posts : Post list) = + posts + |> List.map (fun p -> p.tags) + |> List.concat + |> List.distinct + |> fun tags -> Data.TagMap.findMappingForTags tags webLog.id + open System.Threading.Tasks open DotLiquid open MyWebLog.ViewModels /// Convert a list of posts into items ready to be displayed let private preparePostList webLog posts listType url pageNbr perPage ctx conn = task { - let! authors = getAuthors webLog posts conn + let! authors = getAuthors webLog posts conn + let! tagMappings = getTagMappings webLog posts conn let postItems = posts |> Seq.ofList @@ -64,8 +73,8 @@ let private preparePostList webLog posts listType url pageNbr perPage ctx conn = | CategoryList, _ -> Some $"category/{url}/page/{pageNbr - 1L}" | TagList, 2L -> Some $"tag/{url}/" | TagList, _ -> Some $"tag/{url}/page/{pageNbr - 1L}" - | AdminList, 2L -> Some "posts" - | AdminList, _ -> Some $"posts/page/{pageNbr - 1L}" + | AdminList, 2L -> Some "admin/posts" + | AdminList, _ -> Some $"admin/posts/page/{pageNbr - 1L}" let olderLink = match listType, List.length posts > perPage with | SinglePost, _ -> olderPost |> Option.map (fun p -> Permalink.toString p.permalink) @@ -73,7 +82,7 @@ let private preparePostList webLog posts listType url pageNbr perPage ctx conn = | PostList, true -> Some $"page/{pageNbr + 1L}" | CategoryList, true -> Some $"category/{url}/page/{pageNbr + 1L}" | TagList, true -> Some $"tag/{url}/page/{pageNbr + 1L}" - | AdminList, true -> Some $"posts/page/{pageNbr + 1L}" + | AdminList, true -> Some $"admin/posts/page/{pageNbr + 1L}" let model = { posts = postItems authors = authors @@ -83,7 +92,7 @@ let private preparePostList webLog posts listType url pageNbr perPage ctx conn = olderLink = olderLink olderName = olderPost |> Option.map (fun p -> p.title) } - return Hash.FromAnonymousObject {| model = model; categories = CategoryCache.get ctx |} + return Hash.FromAnonymousObject {| model = model; categories = CategoryCache.get ctx; tag_mappings = tagMappings |} } // GET /page/{pageNbr} @@ -139,7 +148,12 @@ let pageOfTaggedPosts : HttpHandler = fun next ctx -> task { let conn = conn ctx match pathAndPageNumber ctx with | Some pageNbr, rawTag -> - let tag = HttpUtility.UrlDecode rawTag + let urlTag = HttpUtility.UrlDecode rawTag + let! tag = backgroundTask { + match! Data.TagMap.findByUrlValue urlTag webLog.id conn with + | Some m -> return m.tag + | None -> return urlTag + } match! Data.Post.findPageOfTaggedPosts webLog.id tag pageNbr webLog.postsPerPage conn with | posts when List.length posts > 0 -> let! hash = preparePostList webLog posts TagList rawTag pageNbr webLog.postsPerPage ctx conn @@ -254,7 +268,8 @@ let generateFeed : HttpHandler = fun next ctx -> backgroundTask { let private deriveAction ctx : HttpHandler seq = let webLog = WebLogCache.get ctx let conn = conn ctx - let permalink = (string >> Permalink) ctx.Request.RouteValues["link"] + let textLink = string ctx.Request.RouteValues["link"] + let permalink = Permalink textLink let await it = (Async.AwaitTask >> Async.RunSynchronously) it seq { // Current post @@ -273,13 +288,22 @@ let private deriveAction ctx : HttpHandler seq = | None -> () // RSS feed // TODO: configure this via web log - if Permalink.toString permalink = "feed.xml" then yield generateFeed + if textLink = "feed.xml" then yield generateFeed + // Post differing only by trailing slash + let altLink = Permalink (if textLink.EndsWith "/" then textLink[..textLink.Length - 2] else $"{textLink}/") + match Data.Post.findByPermalink altLink webLog.id conn |> await with + | Some post -> yield redirectTo true $"/{Permalink.toString post.permalink}" + | None -> () + // Page differing only by trailing slash + match Data.Page.findByPermalink altLink webLog.id conn |> await with + | Some page -> yield redirectTo true $"/{Permalink.toString page.permalink}" + | None -> () // Prior post - match Data.Post.findCurrentPermalink permalink webLog.id conn |> await with + match Data.Post.findCurrentPermalink [ permalink; altLink ] webLog.id conn |> await with | Some link -> yield redirectTo true $"/{Permalink.toString link}" | None -> () // Prior permalink - match Data.Page.findCurrentPermalink permalink webLog.id conn |> await with + match Data.Page.findCurrentPermalink [ permalink; altLink ] webLog.id conn |> await with | Some link -> yield redirectTo true $"/{Permalink.toString link}" | None -> () } @@ -291,8 +315,8 @@ let catchAll : HttpHandler = fun next ctx -> task { | None -> return! Error.notFound next ctx } -// GET /posts -// GET /posts/page/{pageNbr} +// GET /admin/posts +// GET /admin/posts/page/{pageNbr} let all pageNbr : HttpHandler = requireUser >=> fun next ctx -> task { let webLog = WebLogCache.get ctx let conn = conn ctx @@ -302,7 +326,7 @@ let all pageNbr : HttpHandler = requireUser >=> fun next ctx -> task { return! viewForTheme "admin" "post-list" next ctx hash } -// GET /post/{id}/edit +// GET /admin/post/{id}/edit let edit postId : HttpHandler = requireUser >=> fun next ctx -> task { let webLog = WebLogCache.get ctx let conn = conn ctx @@ -328,7 +352,7 @@ let edit postId : HttpHandler = requireUser >=> fun next ctx -> task { | None -> return! Error.notFound next ctx } -// GET /post/{id}/permalinks +// GET /admin/post/{id}/permalinks let editPermalinks postId : HttpHandler = requireUser >=> fun next ctx -> task { match! Data.Post.findByFullId (PostId postId) (webLogId ctx) (conn ctx) with | Some post -> @@ -342,20 +366,28 @@ let editPermalinks postId : HttpHandler = requireUser >=> fun next ctx -> task { | None -> return! Error.notFound next ctx } -// POST /post/permalinks +// POST /admin/post/permalinks let savePermalinks : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task { let! model = ctx.BindFormAsync () let links = model.prior |> Array.map Permalink |> List.ofArray match! Data.Post.updatePriorPermalinks (PostId model.id) (webLogId ctx) links (conn ctx) with | true -> do! addMessage ctx { UserMessage.success with message = "Post permalinks saved successfully" } - return! redirectToGet $"/post/{model.id}/permalinks" next ctx + return! redirectToGet $"/admin/post/{model.id}/permalinks" next ctx | false -> return! Error.notFound next ctx } +// POST /admin/post/{id}/delete +let delete postId : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task { + match! Data.Post.delete (PostId postId) (webLogId ctx) (conn ctx) 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 +} + #nowarn "3511" -// POST /post/save +// POST /admin/post/save let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task { let! model = ctx.BindFormAsync () let webLogId = webLogId ctx @@ -391,6 +423,7 @@ let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task { tags = model.tags.Split "," |> Seq.ofArray |> Seq.map (fun it -> it.Trim().ToLower ()) + |> Seq.filter (fun it -> it <> "") |> Seq.sort |> List.ofSeq categoryIds = model.categoryIds |> Array.map CategoryId |> List.ofArray @@ -427,6 +460,6 @@ let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task { |> 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 + return! redirectToGet $"/admin/post/{PostId.toString post.id}/edit" next ctx | None -> return! Error.notFound next ctx } diff --git a/src/MyWebLog/Handlers/Routes.fs b/src/MyWebLog/Handlers/Routes.fs index 9c3a21f..42609bc 100644 --- a/src/MyWebLog/Handlers/Routes.fs +++ b/src/MyWebLog/Handlers/Routes.fs @@ -10,63 +10,65 @@ let endpoints = [ ] subRoute "/admin" [ GET [ - route "" Admin.dashboard - route "/settings" Admin.settings + route "" Admin.dashboard + subRoute "/categor" [ + route "ies" Admin.listCategories + routef "y/%s/edit" Admin.editCategory + ] + subRoute "/page" [ + route "s" (Admin.listPages 1) + routef "s/page/%d" Admin.listPages + routef "/%s/edit" Admin.editPage + routef "/%s/permalinks" Admin.editPagePermalinks + ] + subRoute "/post" [ + route "s" (Post.all 1) + routef "s/page/%d" Post.all + routef "/%s/edit" Post.edit + routef "/%s/permalinks" Post.editPermalinks + ] + route "/settings" Admin.settings + subRoute "/tag-mapping" [ + route "s" Admin.tagMappings + routef "/%s/edit" Admin.editMapping + ] + route "/user/edit" User.edit ] POST [ - route "/settings" Admin.saveSettings + subRoute "/category" [ + route "/save" Admin.saveCategory + routef "/%s/delete" Admin.deleteCategory + ] + subRoute "/page" [ + route "/save" Admin.savePage + route "/permalinks" Admin.savePagePermalinks + routef "/%s/delete" Admin.deletePage + ] + subRoute "/post" [ + route "/save" Post.save + route "/permalinks" Post.savePermalinks + routef "/%s/delete" Post.delete + ] + route "/settings" Admin.saveSettings + subRoute "/tag-mapping" [ + route "/save" Admin.saveMapping + routef "/%s/delete" Admin.deleteMapping + ] + route "/user/save" User.save ] ] - subRoute "/categor" [ - GET [ - route "ies" Category.all - routef "y/%s/edit" Category.edit - route "y/{**slug}" Post.pageOfCategorizedPosts - ] - POST [ - route "y/save" Category.save - routef "y/%s/delete" Category.delete - ] - ] - subRoute "/page" [ - GET [ - routef "/%d" Post.pageOfPosts - routef "/%s/edit" Page.edit - routef "/%s/permalinks" Page.editPermalinks - route "s" (Page.all 1) - routef "s/page/%d" Page.all - ] - POST [ - route "/permalinks" Page.savePermalinks - route "/save" Page.save - ] - ] - subRoute "/post" [ - GET [ - routef "/%s/edit" Post.edit - routef "/%s/permalinks" Post.editPermalinks - route "s" (Post.all 1) - routef "s/page/%d" Post.all - ] - POST [ - route "/permalinks" Post.savePermalinks - route "/save" Post.save - ] - ] - subRoute "/tag" [ - GET [ - route "/{**slug}" Post.pageOfTaggedPosts - ] + GET [ + route "/category/{**slug}" Post.pageOfCategorizedPosts + routef "/page/%d" Post.pageOfPosts + route "/tag/{**slug}" Post.pageOfTaggedPosts ] subRoute "/user" [ GET [ - route "/edit" User.edit route "/log-on" (User.logOn None) route "/log-off" User.logOff ] POST [ route "/log-on" User.doLogOn - route "/save" User.save ] ] route "{**link}" Post.catchAll diff --git a/src/MyWebLog/Handlers/User.fs b/src/MyWebLog/Handlers/User.fs index 253196b..cfa4c69 100644 --- a/src/MyWebLog/Handlers/User.fs +++ b/src/MyWebLog/Handlers/User.fs @@ -76,14 +76,14 @@ let private showEdit (hash : Hash) : HttpHandler = fun next ctx -> task { return! viewForTheme "admin" "user-edit" next ctx hash } -// GET /user/edit +// GET /admin/user/edit let edit : HttpHandler = requireUser >=> fun next ctx -> task { match! Data.WebLogUser.findById (userId ctx) (conn ctx) with | Some user -> return! showEdit (Hash.FromAnonymousObject {| model = EditUserModel.fromUser user |}) next ctx | None -> return! Error.notFound next ctx } -// POST /user/save +// POST /admin/user/save let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task { let! model = ctx.BindFormAsync () if model.newPassword = model.newPasswordConfirm then @@ -107,7 +107,7 @@ let save : HttpHandler = requireUser >=> validateCsrf >=> fun next ctx -> task { do! Data.WebLogUser.update user conn let pwMsg = if model.newPassword = "" then "" else " and updated your password" do! addMessage ctx { UserMessage.success with message = $"Saved your information{pwMsg} successfully" } - return! redirectToGet "/user/edit" next ctx + return! redirectToGet "/admin/user/edit" next ctx | None -> return! Error.notFound next ctx else do! addMessage ctx { UserMessage.error with message = "Passwords did not match; no updates made" } diff --git a/src/MyWebLog/MyWebLog.fsproj b/src/MyWebLog/MyWebLog.fsproj index 2497096..e3991e8 100644 --- a/src/MyWebLog/MyWebLog.fsproj +++ b/src/MyWebLog/MyWebLog.fsproj @@ -12,8 +12,6 @@ - - diff --git a/src/MyWebLog/Program.fs b/src/MyWebLog/Program.fs index 1a87eff..3fabce8 100644 --- a/src/MyWebLog/Program.fs +++ b/src/MyWebLog/Program.fs @@ -28,7 +28,26 @@ module DotLiquidBespoke = open System.IO open DotLiquid + open MyWebLog.ViewModels + /// A filter to generate a link with posts categorized under the given category + type CategoryLinkFilter () = + static member CategoryLink (_ : Context, catObj : obj) = + match catObj with + | :? DisplayCategory as cat -> $"/category/{cat.slug}/" + | :? DropProxy as proxy -> $"""/category/{proxy["slug"]}/""" + | _ -> $"alert('unknown category object type {catObj.GetType().Name}')" + + /// A filter to generate a link that will edit a page + type EditPageLinkFilter () = + static member EditPageLink (_ : Context, postId : string) = + $"/admin/page/{postId}/edit" + + /// A filter to generate a link that will edit a post + type EditPostLinkFilter () = + static member EditPostLink (_ : Context, postId : string) = + $"/admin/post/{postId}/edit" + /// A filter to generate nav links, highlighting the active link (exact match) type NavLinkFilter () = static member NavLink (ctx : Context, url : string, text : string) = @@ -43,6 +62,14 @@ module DotLiquidBespoke = } |> Seq.fold (+) "" + /// A filter to generate a link with posts tagged with the given tag + type TagLinkFilter () = + static member TagLink (ctx : Context, tag : string) = + match ctx.Environments[0].["tag_mappings"] :?> TagMap list + |> List.tryFind (fun it -> it.tag = tag) with + | Some tagMap -> $"/tag/{tagMap.urlValue}/" + | None -> $"""/tag/{tag.Replace (" ", "+")}/""" + /// Create links for a user to log on or off, and a dashboard link if they are logged off type UserLinksTag () = inherit Tag () @@ -246,20 +273,24 @@ let main args = let _ = builder.Services.AddGiraffe () // Set up DotLiquid - Template.RegisterFilter typeof - Template.RegisterFilter typeof + [ typeof; typeof + typeof; typeof + typeof; typeof + ] + |> List.iter Template.RegisterFilter + Template.RegisterTag "user_links" [ // Domain types - typeof; typeof; typeof + typeof; typeof; typeof; typeof // View models - typeof; typeof; typeof; typeof - typeof; typeof; typeof; typeof - typeof; typeof; typeof; typeof - typeof + typeof; typeof; typeof; typeof + typeof; typeof; typeof; typeof + typeof; typeof; typeof; typeof + typeof; typeof // Framework types typeof; typeof; typeof; typeof - typeof + typeof; typeof ] |> List.iter (fun it -> Template.RegisterSafeType (it, [| "*" |])) diff --git a/src/MyWebLog/themes/admin/category-edit.liquid b/src/MyWebLog/themes/admin/category-edit.liquid index 5927344..720f919 100644 --- a/src/MyWebLog/themes/admin/category-edit.liquid +++ b/src/MyWebLog/themes/admin/category-edit.liquid @@ -1,6 +1,6 @@ 

{{ page_title }}

-
+
diff --git a/src/MyWebLog/themes/admin/category-list.liquid b/src/MyWebLog/themes/admin/category-list.liquid index 797a788..2cfe7ae 100644 --- a/src/MyWebLog/themes/admin/category-list.liquid +++ b/src/MyWebLog/themes/admin/category-list.liquid @@ -1,6 +1,6 @@ 

{{ page_title }}

- Add a New Category + Add a New Category @@ -18,14 +18,14 @@ {{ cat.name }}
{%- if cat.post_count > 0 %} - + View {{ cat.post_count }} Post{% unless cat.post_count == 1 %}s{% endunless -%} • {%- endif %} - Edit + Edit • - Delete diff --git a/src/MyWebLog/themes/admin/dashboard.liquid b/src/MyWebLog/themes/admin/dashboard.liquid index 18b8c72..452e4f3 100644 --- a/src/MyWebLog/themes/admin/dashboard.liquid +++ b/src/MyWebLog/themes/admin/dashboard.liquid @@ -9,8 +9,8 @@ Published {{ model.posts }}   Drafts {{ model.drafts }} - View All - Write a New Post + View All + Write a New Post @@ -22,8 +22,8 @@ All {{ model.pages }}   Shown in Page List {{ model.listed_pages }} - View All - Create a New Page + View All + Create a New Page @@ -37,8 +37,8 @@ All {{ model.categories }}   Top Level {{ model.top_level_categories }} - View All - Add a New Category + View All + Add a New Category diff --git a/src/MyWebLog/themes/admin/layout.liquid b/src/MyWebLog/themes/admin/layout.liquid index f26122e..1a8fceb 100644 --- a/src/MyWebLog/themes/admin/layout.liquid +++ b/src/MyWebLog/themes/admin/layout.liquid @@ -21,14 +21,15 @@ {% if logged_on -%}
    {{ "admin" | nav_link: "Dashboard" }} - {{ "pages" | nav_link: "Pages" }} - {{ "posts" | nav_link: "Posts" }} - {{ "categories" | nav_link: "Categories" }} + {{ "admin/pages" | nav_link: "Pages" }} + {{ "admin/posts" | nav_link: "Posts" }} + {{ "admin/categories" | nav_link: "Categories" }} + {{ "admin/tag-mappings" | nav_link: "Tag Mappings" }}
{%- endif %}
    {% if logged_on -%} - {{ "user/edit" | nav_link: "Edit User" }} + {{ "admin/user/edit" | nav_link: "Edit User" }} {{ "user/log-off" | nav_link: "Log Off" }} {%- else -%} {{ "user/log-on" | nav_link: "Log On" }} diff --git a/src/MyWebLog/themes/admin/page-edit.liquid b/src/MyWebLog/themes/admin/page-edit.liquid index 5a286ee..e208a05 100644 --- a/src/MyWebLog/themes/admin/page-edit.liquid +++ b/src/MyWebLog/themes/admin/page-edit.liquid @@ -1,6 +1,6 @@

    {{ page_title }}

    - +
    diff --git a/src/MyWebLog/themes/admin/page-list.liquid b/src/MyWebLog/themes/admin/page-list.liquid index 432c753..adb2ec8 100644 --- a/src/MyWebLog/themes/admin/page-list.liquid +++ b/src/MyWebLog/themes/admin/page-list.liquid @@ -1,6 +1,6 @@

    {{ page_title }}

@@ -19,9 +19,12 @@ View Page • - Edit + Edit • - Delete + + Delete + @@ -30,4 +33,7 @@ {%- endfor %}
/{% unless pg.is_default %}{{ pg.permalink }}{% endunless %}
+ + +
diff --git a/src/MyWebLog/themes/admin/permalinks.liquid b/src/MyWebLog/themes/admin/permalinks.liquid index 25bcc0a..7acd1dc 100644 --- a/src/MyWebLog/themes/admin/permalinks.liquid +++ b/src/MyWebLog/themes/admin/permalinks.liquid @@ -1,6 +1,6 @@ 

{{ page_title }}

-
+
@@ -10,7 +10,7 @@ {{ model.current_title }}
{{ model.current_permalink }}
- « Back to Edit {{ model.entity | capitalize }} + « Back to Edit {{ model.entity | capitalize }}

diff --git a/src/MyWebLog/themes/admin/post-edit.liquid b/src/MyWebLog/themes/admin/post-edit.liquid index 9a3a7e3..3f3e88b 100644 --- a/src/MyWebLog/themes/admin/post-edit.liquid +++ b/src/MyWebLog/themes/admin/post-edit.liquid @@ -1,6 +1,6 @@ 

{{ page_title }}

- +
diff --git a/src/MyWebLog/themes/admin/post-list.liquid b/src/MyWebLog/themes/admin/post-list.liquid index f8e8e1c..5f654ea 100644 --- a/src/MyWebLog/themes/admin/post-list.liquid +++ b/src/MyWebLog/themes/admin/post-list.liquid @@ -1,6 +1,6 @@

{{ page_title }}

- Write a New Post + Write a New Post @@ -25,9 +25,12 @@ View Post • - Edit + Edit • - Delete + + Delete + @@ -51,4 +54,7 @@ {% endif %} + + + diff --git a/src/MyWebLog/themes/admin/tag-mapping-edit.liquid b/src/MyWebLog/themes/admin/tag-mapping-edit.liquid new file mode 100644 index 0000000..8c8f0a9 --- /dev/null +++ b/src/MyWebLog/themes/admin/tag-mapping-edit.liquid @@ -0,0 +1,35 @@ +

{{ page_title }}

+ diff --git a/src/MyWebLog/themes/admin/tag-mapping-list.liquid b/src/MyWebLog/themes/admin/tag-mapping-list.liquid new file mode 100644 index 0000000..c430ae7 --- /dev/null +++ b/src/MyWebLog/themes/admin/tag-mapping-list.liquid @@ -0,0 +1,32 @@ +

{{ page_title }}

+
{{ model.authors | value: post.author_id }}
+ + + + + + + + {% for map in mappings -%} + {%- assign map_id = mapping_ids | value: map.tag -%} + + + + + {%- endfor %} + +
TagURL Value
+ {{ map.tag }}
+ + + Delete + + + 		{{ map.url_value }}
+
+ +
+
diff --git a/src/MyWebLog/themes/admin/user-edit.liquid b/src/MyWebLog/themes/admin/user-edit.liquid index 1d1e018..5e13300 100644 --- a/src/MyWebLog/themes/admin/user-edit.liquid +++ b/src/MyWebLog/themes/admin/user-edit.liquid @@ -1,6 +1,6 @@

{{ page_title }}

-
+
diff --git a/src/MyWebLog/themes/bit-badger/home-page.liquid b/src/MyWebLog/themes/bit-badger/home-page.liquid index 164dbcf..94ac8cb 100644 --- a/src/MyWebLog/themes/bit-badger/home-page.liquid +++ b/src/MyWebLog/themes/bit-badger/home-page.liquid @@ -2,7 +2,7 @@
diff --git a/src/MyWebLog/themes/bit-badger/solution-page.liquid b/src/MyWebLog/themes/bit-badger/solution-page.liquid index a9b97d8..cc5cab3 100644 --- a/src/MyWebLog/themes/bit-badger/solution-page.liquid +++ b/src/MyWebLog/themes/bit-badger/solution-page.liquid @@ -94,7 +94,7 @@ {%- endif %}


« Back to All Solutions

{% if logged_on -%} -

Edit This Page

+

Edit This Page

{% endif %}
diff --git a/src/MyWebLog/themes/daniel-j-summers/index.liquid b/src/MyWebLog/themes/daniel-j-summers/index.liquid index 551439c..362806c 100644 --- a/src/MyWebLog/themes/daniel-j-summers/index.liquid +++ b/src/MyWebLog/themes/daniel-j-summers/index.liquid @@ -24,7 +24,7 @@ {% if logged_on %} - Edit Post + Edit Post {% endif %} diff --git a/src/MyWebLog/themes/daniel-j-summers/single-post.liquid b/src/MyWebLog/themes/daniel-j-summers/single-post.liquid index f9d0b14..e9888ad 100644 --- a/src/MyWebLog/themes/daniel-j-summers/single-post.liquid +++ b/src/MyWebLog/themes/daniel-j-summers/single-post.liquid @@ -15,7 +15,7 @@ {% endif %} {{ model.authors | value: post.author_id }} {% if logged_on %} - Edit Post + Edit Post {% endif %}
{{ post.text }}
@@ -27,7 +27,7 @@ {% assign cat = categories | where: "id", cat_id | first %} - + {{ cat.name }}     @@ -40,7 +40,7 @@ Tagged   {% for tag in post.tags %} - +     diff --git a/src/MyWebLog/themes/tech-blog/index.liquid b/src/MyWebLog/themes/tech-blog/index.liquid index f1b8c33..3ad46d2 100644 --- a/src/MyWebLog/themes/tech-blog/index.liquid +++ b/src/MyWebLog/themes/tech-blog/index.liquid @@ -23,7 +23,7 @@ {%- for cat_id in post.category_ids %} {%- assign cat = categories | where: "id", cat_id | first -%} - {%- endfor %}
@@ -34,12 +34,12 @@ Tagged {%- for tag in post.tags %} - + + {%- endfor %}
{%- endif %} - {%- if logged_on %}Edit Post{% endif %} + {%- if logged_on %}Edit Post{% endif %}
{%- endfor %} diff --git a/src/MyWebLog/wwwroot/themes/admin/admin.js b/src/MyWebLog/wwwroot/themes/admin/admin.js index d992c7f..e3c6822 100644 --- a/src/MyWebLog/wwwroot/themes/admin/admin.js +++ b/src/MyWebLog/wwwroot/themes/admin/admin.js @@ -163,7 +163,49 @@ 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.action = `/admin/category/${id}/delete` + form.submit() + } + return false + }, + + /** + * Confirm and delete a page + * @param id The ID of the page to be deleted + * @param title The title of the page to be deleted + */ + deletePage(id, title) { + if (confirm(`Are you sure you want to delete the page "${name}"? This action cannot be undone.`)) { + const form = document.getElementById("deleteForm") + form.action = `/admin/page/${id}/delete` + form.submit() + } + return false + }, + + /** + * Confirm and delete a post + * @param id The ID of the post to be deleted + * @param title The title of the post to be deleted + */ + deletePost(id, title) { + if (confirm(`Are you sure you want to delete the post "${name}"? This action cannot be undone.`)) { + const form = document.getElementById("deleteForm") + form.action = `/admin/post/${id}/delete` + form.submit() + } + return false + }, + + /** + * Confirm and delete a tag mapping + * @param id The ID of the mapping to be deleted + * @param tag The tag for which the mapping will be deleted + */ + deleteTagMapping(id, tag) { + if (confirm(`Are you sure you want to delete the mapping for "${tag}"? This action cannot be undone.`)) { + const form = document.getElementById("deleteForm") + form.action = `/admin/tag-mapping/${id}/delete` form.submit() } return false