bit-badger/myWebLog
1
0
Fork 0
Code Issues 3 Pull Requests Packages Projects Releases 11 Activity

Implement tag mapping

Browse Source 
- 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
This commit is contained in:
Daniel J. Summers 2022-05-21 00:07:16 -04:00
parent ea8d4b1c63
commit 0a21240984
35 changed files with 796 additions and 357 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/MyWebLog.Data/Converters.fs
View File

@ -48,6 +48,13 @@ type PostIdConverter () =
override _.ReadJson (reader : JsonReader, _ : Type, _ : PostId, _ : bool, _ : JsonSerializer) =
(string >> PostId) reader.Value
type TagMapIdConverter () =
inherit JsonConverter<TagMapId> ()
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<WebLogId> ()
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

161
src/MyWebLog.Data/Data.fs
View File

@ -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
@ -51,6 +54,9 @@ module Helpers =
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
open Microsoft.Extensions.Logging
@ -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<string list> { 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<Category list> {
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<Category list> {
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<Result> {
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<Page list> {
@ -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<Permalink list> {
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<Result> {
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<Post list> {
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<Permalink list> {
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<Post list> {
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<Post list> {
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<Post list> {
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<Post> {
withTable Table.Post
@ -579,12 +631,75 @@ 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<Result> {
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<TagMap> {
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<TagMap list> {
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<TagMap list> {
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<TagMap list> {
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 {
let add (webLog : WebLog) = rethink {
withTable Table.WebLog
insert webLog
write; withRetryOnce; ignoreResult
@ -651,7 +766,7 @@ module WebLogUser =
let findNames (webLogId : WebLogId) conn (userIds : WebLogUserId list) = backgroundTask {
let! users = rethink<WebLogUser list> {
withTable Table.WebLogUser
getAll (userIds |> List.map (fun it -> it :> obj))
getAll (objList userIds)
filter "webLogId" webLogId
result; withRetryDefault conn
}

27
src/MyWebLog.Domain/DataTypes.fs
View File

@ -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
[<CLIMutable; NoComparison; NoEquality>]
type WebLog =

16
src/MyWebLog.Domain/SupportTypes.fs
View File

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

24
src/MyWebLog.Domain/ViewModels.fs
View File

@ -255,6 +255,30 @@ type EditPostModel =
}
/// View model to edit a tag mapping
[<CLIMutable; NoComparison; NoEquality>]
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
[<CLIMutable; NoComparison; NoEquality>]
type EditUserModel =

269
src/MyWebLog/Handlers/Admin.fs
View File

@ -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<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 = 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<ManagePermalinksModel> ()
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<EditPageModel> ()
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<EditTagMapModel> ()
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
}

82
src/MyWebLog/Handlers/Category.fs
View File

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

127
src/MyWebLog/Handlers/Page.fs
View File

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

67
src/MyWebLog/Handlers/Post.fs
View File

@ -34,6 +34,14 @@ 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
@ -41,6 +49,7 @@ 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! 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<ManagePermalinksModel> ()
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<EditPostModel> ()
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
}

72
src/MyWebLog/Handlers/Routes.fs
View File

@ -11,62 +11,64 @@ let endpoints = [
subRoute "/admin" [
GET [
route "" Admin.dashboard
route "/settings" Admin.settings
]
POST [
route "/settings" Admin.saveSettings
]
]
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
]
route "ies" Admin.listCategories
routef "y/%s/edit" Admin.editCategory
]
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
]
route "s" (Admin.listPages 1)
routef "s/page/%d" Admin.listPages
routef "/%s/edit" Admin.editPage
routef "/%s/permalinks" Admin.editPagePermalinks
]
subRoute "/post" [
GET [
routef "/%s/edit" Post.edit
routef "/%s/permalinks" Post.editPermalinks
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 "/permalinks" Post.savePermalinks
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 "/tag" [
GET [
route "/{**slug}" Post.pageOfTaggedPosts
]
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

6
src/MyWebLog/Handlers/User.fs
View File

@ -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<EditUserModel> ()
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" }

2
src/MyWebLog/MyWebLog.fsproj
View File

@ -12,8 +12,6 @@
<Compile Include="Handlers\Error.fs" />
<Compile Include="Handlers\Helpers.fs" />
<Compile Include="Handlers\Admin.fs" />
<Compile Include="Handlers\Category.fs" />
<Compile Include="Handlers\Page.fs" />
<Compile Include="Handlers\Post.fs" />
<Compile Include="Handlers\User.fs" />
<Compile Include="Handlers\Routes.fs" />

45
src/MyWebLog/Program.fs
View File

@ -28,6 +28,25 @@ 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 () =
@ -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<DotLiquidBespoke.NavLinkFilter>
Template.RegisterFilter typeof<DotLiquidBespoke.ValueFilter>
[ typeof<DotLiquidBespoke.CategoryLinkFilter>; typeof<DotLiquidBespoke.EditPageLinkFilter>
typeof<DotLiquidBespoke.EditPostLinkFilter>; typeof<DotLiquidBespoke.NavLinkFilter>
typeof<DotLiquidBespoke.TagLinkFilter>; typeof<DotLiquidBespoke.ValueFilter>
]
|> List.iter Template.RegisterFilter
Template.RegisterTag<DotLiquidBespoke.UserLinksTag> "user_links"
[ // Domain types
typeof<MetaItem>; typeof<Page>; typeof<WebLog>
typeof<MetaItem>; typeof<Page>; typeof<TagMap>; typeof<WebLog>
// View models
typeof<DashboardModel>; typeof<DisplayCategory>; typeof<DisplayPage>; typeof<EditCategoryModel>
typeof<EditPageModel>; typeof<EditPostModel>; typeof<EditUserModel>; typeof<LogOnModel>
typeof<ManagePermalinksModel>; typeof<PostDisplay>; typeof<PostListItem>; typeof<SettingsModel>
typeof<UserMessage>
typeof<EditPageModel>; typeof<EditPostModel>; typeof<EditTagMapModel>; typeof<EditUserModel>
typeof<LogOnModel>; typeof<ManagePermalinksModel>; typeof<PostDisplay>; typeof<PostListItem>
typeof<SettingsModel>; typeof<UserMessage>
// Framework types
typeof<AntiforgeryTokenSet>; typeof<KeyValuePair>; typeof<MetaItem list>; typeof<string list>
typeof<string option>
typeof<string option>; typeof<TagMap list>
]
|> List.iter (fun it -> Template.RegisterSafeType (it, [| "*" |]))

2
src/MyWebLog/themes/admin/category-edit.liquid
View File

@ -1,6 +1,6 @@
<h2 class="my-3">{{ page_title }}</h2>
<article>
<form action="/category/save" method="post">
<form action="/admin/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">

8
src/MyWebLog/themes/admin/category-list.liquid
View File

@ -1,6 +1,6 @@
<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>
<a href="/admin/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>
@ -18,14 +18,14 @@
{{ cat.name }}<br>
<small>
{%- if cat.post_count > 0 %}
<a href="/category/{{ cat.slug }}" target="_blank">
<a href="{{ cat | category_link }}" target="_blank">
View {{ cat.post_count }} Post{% unless cat.post_count == 1 %}s{% endunless -%}
</a>
<span class="text-muted"> &bull; </span>
{%- endif %}
<a href="/category/{{ cat.id }}/edit">Edit</a>
<a href="/admin/category/{{ cat.id }}/edit">Edit</a>
<span class="text-muted"> &bull; </span>
<a href="/category/{{ cat.id }}/delete" class="text-danger"
<a href="/admin/category/{{ cat.id }}/delete" class="text-danger"
onclick="return Admin.deleteCategory('{{ cat.id }}', '{{ cat.name }}')">
Delete
</a>

12
src/MyWebLog/themes/admin/dashboard.liquid
View File

@ -9,8 +9,8 @@
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" class="btn btn-secondary me-2">View All</a>
<a href="/post/new/edit" class="btn btn-primary">Write a New Post</a>
<a href="/admin/posts" class="btn btn-secondary me-2">View All</a>
<a href="/admin/post/new/edit" class="btn btn-primary">Write a New Post</a>
</div>
</div>
</section>
@ -22,8 +22,8 @@
All <span class="badge rounded-pill bg-secondary">{{ model.pages }}</span>
&nbsp; Shown in Page List <span class="badge rounded-pill bg-secondary">{{ model.listed_pages }}</span>
</h6>
<a href="/pages" class="btn btn-secondary me-2">View All</a>
<a href="/page/new/edit" class="btn btn-primary">Create a New Page</a>
<a href="/admin/pages" class="btn btn-secondary me-2">View All</a>
<a href="/admin/page/new/edit" class="btn btn-primary">Create a New Page</a>
</div>
</div>
</section>
@ -37,8 +37,8 @@
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" class="btn btn-secondary me-2">View All</a>
<a href="/category/new/edit" class="btn btn-secondary">Add a New Category</a>
<a href="/admin/categories" class="btn btn-secondary me-2">View All</a>
<a href="/admin/category/new/edit" class="btn btn-secondary">Add a New Category</a>
</div>
</div>
</section>

9
src/MyWebLog/themes/admin/layout.liquid
View File

@ -21,14 +21,15 @@
{% if logged_on -%}
<ul class="navbar-nav">
{{ "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" }}
</ul>
{%- endif %}
<ul class="navbar-nav flex-grow-1 justify-content-end">
{% 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" }}

2
src/MyWebLog/themes/admin/page-edit.liquid
View File

@ -1,6 +1,6 @@
<h2 class="my-3">{{ page_title }}</h2>
<article>
<form action="/page/save" method="post">
<form action="/admin/page/save" method="post">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<input type="hidden" name="pageId" value="{{ model.page_id }}">
<div class="container">

12
src/MyWebLog/themes/admin/page-list.liquid
View File

@ -1,6 +1,6 @@
<h2 class="my-3">{{ page_title }}</h2>
<article class="container">
<a href="/page/new/edit" class="btn btn-primary btn-sm mb-3">Create a New Page</a>
<a href="/admin/page/new/edit" class="btn btn-primary btn-sm mb-3">Create a New Page</a>
<table class="table table-sm table-hover">
<thead>
<tr>
@ -19,9 +19,12 @@
<small>
<a href="/{% unless pg.is_default %}{{ pg.permalink }}{% endunless %}" target="_blank">View Page</a>
<span class="text-muted"> &bull; </span>
<a href="/page/{{ pg.id }}/edit">Edit</a>
<a href="{{ pg.id | edit_page_link }}">Edit</a>
<span class="text-muted"> &bull; </span>
<a href="#" class="text-danger">Delete</a>
<a href="/admin/page/{{ pg.id }}/delete" class="text-danger"
onclick="return Admin.deletePage('{{ pg.id }}', '{{ pg.title }}')">
Delete
</a>
</small>
</td>
<td>/{% unless pg.is_default %}{{ pg.permalink }}{% endunless %}</td>
@ -30,4 +33,7 @@
{%- endfor %}
</tbody>
</table>
<form method="post" id="deleteForm">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
</form>
</article>

4
src/MyWebLog/themes/admin/permalinks.liquid
View File

@ -1,6 +1,6 @@
<h2 class="my-3">{{ page_title }}</h2>
<article>
<form action="/{{ model.entity }}/permalinks" method="post">
<form action="/admin/{{ model.entity }}/permalinks" method="post">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<input type="hidden" name="id" value="{{ model.id }}">
<div class="container">
@ -10,7 +10,7 @@
<strong>{{ model.current_title }}</strong><br>
<small class="text-muted">
<span class="fst-italic">{{ model.current_permalink }}</span><br>
<a href="/{{ model.entity }}/{{ model.id }}/edit">&laquo; Back to Edit {{ model.entity | capitalize }}</a>
<a href="/admin/{{ model.entity }}/{{ model.id }}/edit">&laquo; Back to Edit {{ model.entity | capitalize }}</a>
</small>
</p>
</div>

2
src/MyWebLog/themes/admin/post-edit.liquid
View File

@ -1,6 +1,6 @@
<h2 class="my-3">{{ page_title }}</h2>
<article>
<form action="/post/save" method="post">
<form action="/admin/post/save" method="post">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<input type="hidden" name="postId" value="{{ model.post_id }}">
<div class="container">

12
src/MyWebLog/themes/admin/post-list.liquid
View File

@ -1,6 +1,6 @@
<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>
<a href="/admin/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>
@ -25,9 +25,12 @@
<small>
<a href="/{{ post.permalink }}" target="_blank">View Post</a>
<span class="text-muted"> &bull; </span>
<a href="/post/{{ post.id }}/edit">Edit</a>
<a href="{{ post.id | edit_post_link }}">Edit</a>
<span class="text-muted"> &bull; </span>
<a href="#" class="text-danger">Delete</a>
<a href="/admin/post/{{ pg.id }}/delete" class="text-danger"
onclick="return Admin.deletePost('{{ post.id }}', '{{ post.title }}')">
Delete
</a>
</small>
</td>
<td class="no-wrap">{{ model.authors | value: post.author_id }}</td>
@ -51,4 +54,7 @@
</div>
</div>
{% endif %}
<form method="post" id="deleteForm">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
</form>
</article>

35
src/MyWebLog/themes/admin/tag-mapping-edit.liquid Normal file
View File

@ -0,0 +1,35 @@
<h2 class="my-3">{{ page_title }}</h2>
<article>
<form action="/admin/tag-mapping/save" method="post">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<input type="hidden" name="id" value="{{ model.id }}">
<div class="container">
<div class="row mb-3">
<div class="col">
<a href="/admin/tag-mappings">&laquo; Back to Tag Mappings</a>
</div>
</div>
<div class="row mb-3">
<div class="col-6 col-lg-4 pb-3">
<div class="form-floating">
<input type="text" name="tag" id="tag" class="form-control" placeholder="Tag" autofocus required
value="{{ model.tag }}">
<label for="tag">Tag</label>
</div>
</div>
<div class="col-6 col-lg-4 pb-3">
<div class="form-floating">
<input type="text" name="urlValue" id="urlValue" class="form-control" placeholder="URL Value" required
value="{{ model.url_value }}">
<label for="urlValue">URL Value</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>

32
src/MyWebLog/themes/admin/tag-mapping-list.liquid Normal file
View File

@ -0,0 +1,32 @@
<h2 class="my-3">{{ page_title }}</h2>
<article class="container">
<a href="/admin/tag-mapping/new/edit" class="btn btn-primary btn-sm mb-3">Add a New Tag Mapping</a>
<table class="table table-sm table-hover">
<thead>
<tr>
<th scope="col">Tag</th>
<th scope="col">URL Value</th>
</tr>
</thead>
<tbody>
{% for map in mappings -%}
{%- assign map_id = mapping_ids | value: map.tag -%}
<tr>
<td class="no-wrap">
{{ map.tag }}<br>
<small>
<a href="/admin/tag-mapping/{{ map_id }}/delete" class="text-danger"
onclick="return Admin.deleteTagMapping('{{ map_id }}', '{{ map.tag }}')">
Delete
</a>
</small>
</td>
<td>{{ map.url_value }}</td>
</tr>
{%- endfor %}
</tbody>
</table>
<form method="post" id="deleteForm">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
</form>
</article>

2
src/MyWebLog/themes/admin/user-edit.liquid
View File

@ -1,6 +1,6 @@
<h2 class="my-3">{{ page_title }}</h2>
<article>
<form action="/user/save" method="post">
<form action="/admin/user/save" method="post">
<input type="hidden" name="{{ csrf.form_field_name }}" value="{{ csrf.request_token }}">
<div class="container">
<div class="row mb-3">

2
src/MyWebLog/themes/bit-badger/home-page.liquid
View File

@ -2,7 +2,7 @@
<article class="content auto">
{{ page.text }}
{% if logged_on -%}
<p><small><a href="/page/{{ page.id }}/edit">Edit This Page</a></small></p>
<p><small><a href="{{ page.id | edit_page_link }}">Edit This Page</a></small></p>
{% endif %}
</article>
<aside class="app-sidebar">

2
src/MyWebLog/themes/bit-badger/single-page.liquid
View File

@ -3,6 +3,6 @@
{{ page.text }}
<p><br><a href="/" title="Home">&laquo; Home</a></p>
{% if logged_on -%}
<p><small><a href="/page/{{ page.id }}/edit">Edit This Page</a></small></p>
<p><small><a href="{{ page.id | edit_page_link }}">Edit This Page</a></small></p>
{% endif %}
</article>

2
src/MyWebLog/themes/bit-badger/solution-page.liquid
View File

@ -94,7 +94,7 @@
{%- endif %}
<p><br><a href="/solutions">&laquo; Back to All Solutions</a></p>
{% if logged_on -%}
<p><small><a href="/page/{{ page.id }}/edit">Edit This Page</a></small></p>
<p><small><a href="{{ page.id | edit_page_link }}">Edit This Page</a></small></p>
{% endif %}
</article>
</div>

2
src/MyWebLog/themes/daniel-j-summers/index.liquid
View File

@ -24,7 +24,7 @@
</span>
{% if logged_on %}
<span>
<a href="/post/{{ post.id }}/edit"><i class="fa fa-pencil-square-o"></i> Edit Post</a>
<a href="{{ post.id | edit_post_link }}"><i class="fa fa-pencil-square-o"></i> Edit Post</a>
</span>
{% endif %}
</h4>

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

@ -15,7 +15,7 @@
{% endif %}
<span title="Author"><i class="fa fa-user"></i> {{ model.authors | value: post.author_id }}</span>
{% if logged_on %}
<span><a href="/post/{{ post.id }}/edit"><i class="fa fa-pencil-square-o"></i> Edit Post</a></span>
<span><a href="{{ post.id | edit_post_link }}"><i class="fa fa-pencil-square-o"></i> Edit Post</a></span>
{% endif %}
</h4>
<div>{{ post.text }}</div>
@ -27,7 +27,7 @@
{% assign cat = categories | where: "id", cat_id | first %}
<span class="no-wrap">
<i class="fa fa-folder-open-o" title="Category"></i>
<a href="/category/{{ cat.slug }}/" title="Categorized under &ldquo;{{ cat.name | escape }}&rdquo;">
<a href="{{ cat.slug | category_link }}" title="Categorized under &ldquo;{{ cat.name | escape }}&rdquo;">
{{ cat.name }}
</a> &nbsp; &nbsp;
</span>
@ -40,7 +40,7 @@
Tagged &nbsp;
{% for tag in post.tags %}
<span class="no-wrap">
<a href="/tag/{{ tag | replace: " ", "+" }}/" title="Posts tagged &ldquo;{{ tag | escape }}&rdquo;">
<a href="{{ tag | tag_link }}" title="Posts tagged &ldquo;{{ tag | escape }}&rdquo;" rel="tag">
<i class="fa fa-tag"></i> {{ tag }}
</a> &nbsp; &nbsp;
</span>

8
src/MyWebLog/themes/tech-blog/index.liquid
View File

@ -23,7 +23,7 @@
{%- for cat_id in post.category_ids %}
{%- assign cat = categories | where: "id", cat_id | first -%}
<span>
<a href="/category/{{ cat.slug }}/"
<a href="{{ cat | category_link }}"
title="Categorized under {{ cat.name | strip_html | escape }}" rel="tag">{{ cat.name }}</a></span>
{%- endfor %}
</small><br>
@ -34,12 +34,12 @@
Tagged
{%- for tag in post.tags %}
<span>
<a href="/tag/{{ tag | replace: " ", "+" }}/"
title="Tagged &ldquo;{{ tag | escape }}&rdquo;" rel="tag">{{ tag }}</a></span>
<a href="{{ tag | tag_link }}" title="Tagged &ldquo;{{ tag | escape }}&rdquo;" rel="tag">{{ tag }}</a>
</span>
{%- endfor %}
</small><br>
{%- endif %}
{%- if logged_on %}<small><a href="/post/{{ post.id }}/edit">Edit Post</a></small>{% endif %}
{%- if logged_on %}<small><a href="{{ post.id | edit_post_link }}">Edit Post</a></small>{% endif %}
</article>
{%- endfor %}
<div class="bottom-nav" role="navigation">

2
src/MyWebLog/themes/tech-blog/layout.liquid
View File

@ -57,7 +57,7 @@
{% for cat in categories -%}
{%- assign indent = cat.parent_names | size -%}
<li class="cat-list-item"{% if indent > 0 %} style="padding-left:{{ indent }}rem;"{% endif %}>
<a href="/category/{{ cat.slug }}/" class="cat-list-link">{{ cat.name }}</a>
<a href="{{ cat | category_link }}" class="cat-list-link">{{ cat.name }}</a>
<span class="cat-list-count">{{ cat.post_count }}</span>
</li>
{%- endfor %}

2
src/MyWebLog/themes/tech-blog/single-page.liquid
View File

@ -1,5 +1,5 @@
<article class="auto">
<h1 class="entry-title">{{ page.title }}</h1>
<div class="entry-content">{{ page.text }}</div>
{%- if logged_on %}<p><small><a href="/page/{{ page.id }}/edit">Edit Page</a></small></p>{% endif %}
{%- if logged_on %}<p><small><a href="{{ page.id | edit_page_link }}">Edit Page</a></small></p>{% endif %}
</article>

13
src/MyWebLog/themes/tech-blog/single-post.liquid
View File

@ -13,8 +13,11 @@
{%- for cat_id in post.category_ids %}
{%- assign cat = categories | where: "id", cat_id | first -%}
<span>
<a href="/category/{{ cat.slug }}/"
title="Categorized under {{ cat.name | strip_html | escape }}" rel="tag">{{ cat.name }}</a></span>
<a href="{{ cat | category_link }}" title="Categorized under {{ cat.name | strip_html | escape }}"
rel="tag">
{{ cat.name }}
</a>
</span>
{%- endfor %}
</small>
{%- endif %}
@ -28,14 +31,14 @@
Tagged
{%- for tag in post.tags %}
<span>
<a href="/tag/{{ tag | replace: " ", "+" }}/"
title="Tagged &ldquo;{{ tag | escape }}&rdquo;" rel="tag">{{ tag }}</a></span>
<a href="{{ tag | tag_link }}" title="Tagged &ldquo;{{ tag | escape }}&rdquo;" rel="tag">{{ tag }}</a>
</span>
{%- endfor %}
</span> &bull;
{%- endif %}
Bookmark the
<a href="/{{ post.permalink }}" rel="bookmark"
title="Permanent link to &ldquo;{{ post.title | strip_html | escape }}&rdquo;">permalink</a>
{%- if logged_on %} &bull; <a href="/post/{{ post.id }}/edit">Edit Post</a>{% endif %}
{%- if logged_on %} &bull; <a href="{{ post.id | edit_post_link }}">Edit Post</a>{% endif %}
</div>
</article>

44
src/MyWebLog/wwwroot/themes/admin/admin.js
View File

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