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

Version 2.1 #41

Merged
danieljsummers merged 123 commits from version-2.1 into main 2024-03-27 00:13:28 +00:00
Conversation 0 Commits 123 Files Changed 116 +548 -565
24 changed files with 548 additions and 565 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files
Showing only changes of commit 5fe2077974 - Show all commits

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

@ -54,35 +54,35 @@ module Json =
type MarkupTextConverter() =
inherit JsonConverter<MarkupText>()
override _.WriteJson(writer: JsonWriter, value: MarkupText, _: JsonSerializer) =
writer.WriteValue (MarkupText.toString value)
writer.WriteValue value.Value
override _.ReadJson(reader: JsonReader, _: Type, _: MarkupText, _: bool, _: JsonSerializer) =
(string >> MarkupText.parse) reader.Value
(string >> MarkupText.Parse) reader.Value
type PermalinkConverter() =
inherit JsonConverter<Permalink>()
override _.WriteJson(writer: JsonWriter, value: Permalink, _: JsonSerializer) =
writer.WriteValue (Permalink.toString value)
writer.WriteValue value.Value
override _.ReadJson(reader: JsonReader, _: Type, _: Permalink, _: bool, _: JsonSerializer) =
(string >> Permalink) reader.Value
type PageIdConverter() =
inherit JsonConverter<PageId>()
override _.WriteJson(writer: JsonWriter, value: PageId, _: JsonSerializer) =
writer.WriteValue (PageId.toString value)
writer.WriteValue value.Value
override _.ReadJson(reader: JsonReader, _: Type, _: PageId, _: bool, _: JsonSerializer) =
(string >> PageId) reader.Value
type PodcastMediumConverter() =
inherit JsonConverter<PodcastMedium>()
override _.WriteJson(writer: JsonWriter, value: PodcastMedium, _: JsonSerializer) =
writer.WriteValue (PodcastMedium.toString value)
writer.WriteValue value.Value
override _.ReadJson(reader: JsonReader, _: Type, _: PodcastMedium, _: bool, _: JsonSerializer) =
(string >> PodcastMedium.parse) reader.Value
(string >> PodcastMedium.Parse) reader.Value
type PostIdConverter() =
inherit JsonConverter<PostId>()
override _.WriteJson(writer: JsonWriter, value: PostId, _: JsonSerializer) =
writer.WriteValue (PostId.toString value)
writer.WriteValue value.Value
override _.ReadJson(reader: JsonReader, _: Type, _: PostId, _: bool, _: JsonSerializer) =
(string >> PostId) reader.Value

11
src/MyWebLog.Data/Postgres/PostgresCategoryData.fs
View File

@ -33,7 +33,7 @@ type PostgresCategoryData (log : ILogger) =
let catIdSql, catIdParams =
ordered
|> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name)
|> Seq.map (fun cat -> cat.Id)
|> Seq.map _.Id
|> Seq.append (Seq.singleton it.Id)
|> List.ofSeq
|> arrayContains (nameof Post.empty.CategoryIds) id
@ -43,10 +43,9 @@ type PostgresCategoryData (log : ILogger) =
FROM {Table.Post}
WHERE {Query.whereDataContains "@criteria"}
AND {catIdSql}"""
[ "@criteria",
Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |}
catIdParams
] Map.toCount
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = Published.Value |}
catIdParams ]
Map.toCount
|> Async.AwaitTask
|> Async.RunSynchronously
it.Id, postCount)
@ -107,7 +106,7 @@ type PostgresCategoryData (log : ILogger) =
|> Sql.executeTransactionAsync [
Query.Update.partialById Table.Post,
posts |> List.map (fun post -> [
"@id", Sql.string (PostId.toString post.Id)
"@id", Sql.string post.Id.Value
"@data", Query.jsonbDocParam
{| CategoryIds = post.CategoryIds |> List.filter (fun cat -> cat <> catId) |}
])

4
src/MyWebLog.Data/Postgres/PostgresHelpers.fs
View File

@ -144,7 +144,7 @@ module Map =
/// Create a revision from the current row
let toRevision (row : RowReader) : Revision =
{ AsOf = row.fieldValue<Instant> "as_of"
Text = row.string "revision_text" |> MarkupText.parse
Text = row.string "revision_text" |> MarkupText.Parse
}
/// Create a theme asset from the current row
@ -206,7 +206,7 @@ module Revisions =
let revParams<'TKey> (key : 'TKey) (keyFunc : 'TKey -> string) rev = [
typedParam "asOf" rev.AsOf
"@id", Sql.string (keyFunc key)
"@text", Sql.string (MarkupText.toString rev.Text)
"@text", Sql.string rev.Text.Value
]
/// The SQL statement to insert a revision

28
src/MyWebLog.Data/Postgres/PostgresPageData.fs
View File

@ -14,7 +14,7 @@ type PostgresPageData (log : ILogger) =
/// Append revisions to a page
let appendPageRevisions (page: Page) = backgroundTask {
log.LogTrace "Page.appendPageRevisions"
let! revisions = Revisions.findByEntityId Table.PageRevision Table.Page page.Id PageId.toString
let! revisions = Revisions.findByEntityId Table.PageRevision Table.Page page.Id _.Value
return { page with Revisions = revisions }
}
@ -23,14 +23,14 @@ type PostgresPageData (log : ILogger) =
{ fromData<Page> row with Text = "" }
/// Update a page's revisions
let updatePageRevisions pageId oldRevs newRevs =
let updatePageRevisions (pageId: PageId) oldRevs newRevs =
log.LogTrace "Page.updatePageRevisions"
Revisions.update Table.PageRevision Table.Page pageId PageId.toString oldRevs newRevs
Revisions.update Table.PageRevision Table.Page pageId (_.Value) oldRevs newRevs
/// Does the given page exist?
let pageExists pageId webLogId =
let pageExists (pageId: PageId) webLogId =
log.LogTrace "Page.pageExists"
Document.existsByWebLog Table.Page pageId PageId.toString webLogId
Document.existsByWebLog Table.Page pageId (_.Value) webLogId
// IMPLEMENTATION FUNCTIONS
@ -51,9 +51,9 @@ type PostgresPageData (log : ILogger) =
Count.byContains Table.Page {| webLogDoc webLogId with IsInPageList = true |}
/// Find a page by its ID (without revisions)
let findById pageId webLogId =
let findById (pageId: PageId) webLogId =
log.LogTrace "Page.findById"
Document.findByIdAndWebLog<PageId, Page> Table.Page pageId PageId.toString webLogId
Document.findByIdAndWebLog<PageId, Page> Table.Page pageId (_.Value) webLogId
/// Find a complete page by its ID
let findFullById pageId webLogId = backgroundTask {
@ -70,15 +70,15 @@ type PostgresPageData (log : ILogger) =
log.LogTrace "Page.delete"
match! pageExists pageId webLogId with
| true ->
do! Delete.byId Table.Page (PageId.toString pageId)
do! Delete.byId Table.Page pageId.Value
return true
| false -> return false
}
/// Find a page by its permalink for the given web log
let findByPermalink permalink webLogId =
let findByPermalink (permalink: Permalink) webLogId =
log.LogTrace "Page.findByPermalink"
Find.byContains<Page> Table.Page {| webLogDoc webLogId with Permalink = Permalink.toString permalink |}
Find.byContains<Page> Table.Page {| webLogDoc webLogId with Permalink = permalink.Value |}
|> tryHead
/// Find the current permalink within a set of potential prior permalinks for the given web log
@ -87,7 +87,7 @@ type PostgresPageData (log : ILogger) =
if List.isEmpty permalinks then return None
else
let linkSql, linkParam =
arrayContains (nameof Page.empty.PriorPermalinks) Permalink.toString permalinks
arrayContains (nameof Page.empty.PriorPermalinks) (fun (it: Permalink) -> it.Value) permalinks
return!
Custom.single
$"""SELECT data ->> '{nameof Page.empty.Permalink}' AS permalink
@ -134,9 +134,9 @@ type PostgresPageData (log : ILogger) =
|> Sql.executeTransactionAsync [
Query.insert Table.Page,
pages
|> List.map (fun page -> Query.docParameters (PageId.toString page.Id) { page with Revisions = [] })
|> List.map (fun page -> Query.docParameters page.Id.Value { page with Revisions = [] })
Revisions.insertSql Table.PageRevision,
revisions |> List.map (fun (pageId, rev) -> Revisions.revParams pageId PageId.toString rev)
revisions |> List.map (fun (pageId, rev) -> Revisions.revParams pageId (_.Value) rev)
]
()
}
@ -155,7 +155,7 @@ type PostgresPageData (log : ILogger) =
log.LogTrace "Page.updatePriorPermalinks"
match! pageExists pageId webLogId with
| true ->
do! Update.partialById Table.Page (PageId.toString pageId) {| PriorPermalinks = permalinks |}
do! Update.partialById Table.Page pageId.Value {| PriorPermalinks = permalinks |}
return true
| false -> return false
}

46
src/MyWebLog.Data/Postgres/PostgresPostData.fs
View File

@ -15,7 +15,7 @@ type PostgresPostData (log : ILogger) =
/// Append revisions to a post
let appendPostRevisions (post: Post) = backgroundTask {
log.LogTrace "Post.appendPostRevisions"
let! revisions = Revisions.findByEntityId Table.PostRevision Table.Post post.Id PostId.toString
let! revisions = Revisions.findByEntityId Table.PostRevision Table.Post post.Id _.Value
return { post with Revisions = revisions }
}
@ -24,34 +24,33 @@ type PostgresPostData (log : ILogger) =
{ fromData<Post> row with Text = "" }
/// Update a post's revisions
let updatePostRevisions postId oldRevs newRevs =
let updatePostRevisions (postId: PostId) oldRevs newRevs =
log.LogTrace "Post.updatePostRevisions"
Revisions.update Table.PostRevision Table.Post postId PostId.toString oldRevs newRevs
Revisions.update Table.PostRevision Table.Post postId (_.Value) oldRevs newRevs
/// Does the given post exist?
let postExists postId webLogId =
let postExists (postId: PostId) webLogId =
log.LogTrace "Post.postExists"
Document.existsByWebLog Table.Post postId PostId.toString webLogId
Document.existsByWebLog Table.Post postId (_.Value) webLogId
// IMPLEMENTATION FUNCTIONS
/// Count posts in a status for the given web log
let countByStatus status webLogId =
let countByStatus (status: PostStatus) webLogId =
log.LogTrace "Post.countByStatus"
Count.byContains Table.Post {| webLogDoc webLogId with Status = PostStatus.toString status |}
Count.byContains Table.Post {| webLogDoc webLogId with Status = status.Value |}
/// Find a post by its ID for the given web log (excluding revisions)
let findById postId webLogId =
log.LogTrace "Post.findById"
Document.findByIdAndWebLog<PostId, Post> Table.Post postId PostId.toString webLogId
Document.findByIdAndWebLog<PostId, Post> Table.Post postId (_.Value) webLogId
/// Find a post by its permalink for the given web log (excluding revisions and prior permalinks)
let findByPermalink permalink webLogId =
let findByPermalink (permalink: Permalink) webLogId =
log.LogTrace "Post.findByPermalink"
Custom.single (selectWithCriteria Table.Post)
[ "@criteria",
Query.jsonbDocParam {| webLogDoc webLogId with Permalink = Permalink.toString permalink |}
] fromData<Post>
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Permalink = permalink.Value |} ]
fromData<Post>
/// Find a complete post by its ID for the given web log
let findFullById postId webLogId = backgroundTask {
@ -68,11 +67,10 @@ type PostgresPostData (log : ILogger) =
log.LogTrace "Post.delete"
match! postExists postId webLogId with
| true ->
let theId = PostId.toString postId
do! Custom.nonQuery
$"""DELETE FROM {Table.PostComment} WHERE {Query.whereDataContains "@criteria"};
DELETE FROM {Table.Post} WHERE id = @id"""
[ "@id", Sql.string theId; "@criteria", Query.jsonbDocParam {| PostId = theId |} ]
[ "@id", Sql.string postId.Value; "@criteria", Query.jsonbDocParam {| PostId = postId.Value |} ]
return true
| false -> return false
}
@ -83,7 +81,7 @@ type PostgresPostData (log : ILogger) =
if List.isEmpty permalinks then return None
else
let linkSql, linkParam =
arrayContains (nameof Post.empty.PriorPermalinks) Permalink.toString permalinks
arrayContains (nameof Post.empty.PriorPermalinks) (fun (it: Permalink) -> it.Value) permalinks
return!
Custom.single
$"""SELECT data ->> '{nameof Post.empty.Permalink}' AS permalink
@ -106,13 +104,14 @@ type PostgresPostData (log : ILogger) =
/// Get a page of categorized posts for the given web log (excludes revisions)
let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage =
log.LogTrace "Post.findPageOfCategorizedPosts"
let catSql, catParam = arrayContains (nameof Post.empty.CategoryIds) (_.Value) categoryIds
let catSql, catParam =
arrayContains (nameof Post.empty.CategoryIds) (fun (it: CategoryId) -> it.Value) categoryIds
Custom.list
$"{selectWithCriteria Table.Post}
AND {catSql}
ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |}
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = Published.Value |}
catParam
] fromData<Post>
@ -133,7 +132,7 @@ type PostgresPostData (log : ILogger) =
$"{selectWithCriteria Table.Post}
ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |} ]
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = Published.Value |} ]
fromData<Post>
/// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks)
@ -144,7 +143,7 @@ type PostgresPostData (log : ILogger) =
AND data['{nameof Post.empty.Tags}'] @> @tag
ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |}
[ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = Published.Value |}
"@tag", Query.jsonbDocParam [| tag |]
] fromData<Post>
@ -152,7 +151,7 @@ type PostgresPostData (log : ILogger) =
let findSurroundingPosts webLogId publishedOn = backgroundTask {
log.LogTrace "Post.findSurroundingPosts"
let queryParams () = [
"@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |}
"@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = Published.Value |}
"@publishedOn", Sql.string ((InstantPattern.General.Format publishedOn).Substring (0, 19))
]
let pubField = nameof Post.empty.PublishedOn
@ -188,10 +187,9 @@ type PostgresPostData (log : ILogger) =
|> Sql.fromDataSource
|> Sql.executeTransactionAsync [
Query.insert Table.Post,
posts
|> List.map (fun post -> Query.docParameters (PostId.toString post.Id) { post with Revisions = [] })
posts |> List.map (fun post -> Query.docParameters post.Id.Value { post with Revisions = [] })
Revisions.insertSql Table.PostRevision,
revisions |> List.map (fun (postId, rev) -> Revisions.revParams postId PostId.toString rev)
revisions |> List.map (fun (postId, rev) -> Revisions.revParams postId (_.Value) rev)
]
()
}
@ -201,7 +199,7 @@ type PostgresPostData (log : ILogger) =
log.LogTrace "Post.updatePriorPermalinks"
match! postExists postId webLogId with
| true ->
do! Update.partialById Table.Post (PostId.toString postId) {| PriorPermalinks = permalinks |}
do! Update.partialById Table.Post postId.Value {| PriorPermalinks = permalinks |}
return true
| false -> return false
}

2
src/MyWebLog.Data/Postgres/PostgresUploadData.fs
View File

@ -22,7 +22,7 @@ type PostgresUploadData (log : ILogger) =
webLogIdParam upload.WebLogId
typedParam "updatedOn" upload.UpdatedOn
"@id", Sql.string (UploadId.toString upload.Id)
"@path", Sql.string (Permalink.toString upload.Path)
"@path", Sql.string upload.Path.Value
"@data", Sql.bytea upload.Data
]

2
src/MyWebLog.Data/RethinkDbData.fs
View File

@ -917,7 +917,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
delete
write; withRetryDefault; ignoreResult conn
}
return Ok (Permalink.toString up.Path)
return Ok up.Path.Value
| None -> return Result.Error $"Upload ID {UploadId.toString uploadId} not found"
}

4
src/MyWebLog.Data/SQLite/Helpers.fs
View File

@ -254,7 +254,7 @@ module Map =
Id = getString "id" rdr |> PostId
WebLogId = getString "web_log_id" rdr |> WebLogId
AuthorId = getString "author_id" rdr |> WebLogUserId
Status = getString "status" rdr |> PostStatus.parse
Status = getString "status" rdr |> PostStatus.Parse
Title = getString "title" rdr
Permalink = toPermalink rdr
PublishedOn = tryInstant "published_on" rdr
@ -270,7 +270,7 @@ module Map =
/// Create a revision from the current row in the given data reader
let toRevision rdr : Revision =
{ AsOf = getInstant "as_of" rdr
Text = getString "revision_text" rdr |> MarkupText.parse
Text = getString "revision_text" rdr |> MarkupText.Parse
}
/// Create a tag mapping from the current row in the given data reader

34
src/MyWebLog.Data/SQLite/SQLitePageData.fs
View File

@ -13,11 +13,11 @@ type SQLitePageData (conn : SqliteConnection, ser : JsonSerializer) =
/// Add parameters for page INSERT or UPDATE statements
let addPageParameters (cmd: SqliteCommand) (page: Page) =
[ cmd.Parameters.AddWithValue ("@id", PageId.toString page.Id)
[ cmd.Parameters.AddWithValue ("@id", page.Id.Value)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString page.WebLogId)
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString page.AuthorId)
cmd.Parameters.AddWithValue ("@title", page.Title)
cmd.Parameters.AddWithValue ("@permalink", Permalink.toString page.Permalink)
cmd.Parameters.AddWithValue ("@permalink", page.Permalink.Value)
cmd.Parameters.AddWithValue ("@publishedOn", instantParam page.PublishedOn)
cmd.Parameters.AddWithValue ("@updatedOn", instantParam page.UpdatedOn)
cmd.Parameters.AddWithValue ("@isInPageList", page.IsInPageList)
@ -30,7 +30,7 @@ type SQLitePageData (conn : SqliteConnection, ser : JsonSerializer) =
/// Append revisions and permalinks to a page
let appendPageRevisionsAndPermalinks (page : Page) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@pageId", PageId.toString page.Id) |> ignore
cmd.Parameters.AddWithValue ("@pageId", page.Id.Value) |> ignore
cmd.CommandText <- "SELECT permalink FROM page_permalink WHERE page_id = @pageId"
use! rdr = cmd.ExecuteReaderAsync ()
@ -51,17 +51,17 @@ type SQLitePageData (conn : SqliteConnection, ser : JsonSerializer) =
{ toPage rdr with Text = "" }
/// Update a page's prior permalinks
let updatePagePermalinks pageId oldLinks newLinks = backgroundTask {
let updatePagePermalinks (pageId: PageId) oldLinks newLinks = backgroundTask {
let toDelete, toAdd = Utils.diffPermalinks oldLinks newLinks
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId)
[ cmd.Parameters.AddWithValue ("@pageId", pageId.Value)
cmd.Parameters.Add ("@link", SqliteType.Text)
] |> ignore
let runCmd link = backgroundTask {
cmd.Parameters["@link"].Value <- Permalink.toString link
let runCmd (link: Permalink) = backgroundTask {
cmd.Parameters["@link"].Value <- link.Value
do! write cmd
}
cmd.CommandText <- "DELETE FROM page_permalink WHERE page_id = @pageId AND permalink = @link"
@ -77,7 +77,7 @@ type SQLitePageData (conn : SqliteConnection, ser : JsonSerializer) =
}
/// Update a page's revisions
let updatePageRevisions pageId oldRevs newRevs = backgroundTask {
let updatePageRevisions (pageId: PageId) oldRevs newRevs = backgroundTask {
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
@ -85,10 +85,10 @@ type SQLitePageData (conn : SqliteConnection, ser : JsonSerializer) =
use cmd = conn.CreateCommand ()
let runCmd withText rev = backgroundTask {
cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId)
[ cmd.Parameters.AddWithValue ("@pageId", pageId.Value)
cmd.Parameters.AddWithValue ("@asOf", instantParam rev.AsOf)
] |> ignore
if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.Text) |> ignore
if withText then cmd.Parameters.AddWithValue ("@text", rev.Text.Value) |> ignore
do! write cmd
}
cmd.CommandText <- "DELETE FROM page_revision WHERE page_id = @pageId AND as_of = @asOf"
@ -154,12 +154,12 @@ type SQLitePageData (conn : SqliteConnection, ser : JsonSerializer) =
}
/// Find a page by its ID (without revisions and prior permalinks)
let findById pageId webLogId = backgroundTask {
let findById (pageId: PageId) webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM page WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore
cmd.Parameters.AddWithValue ("@id", pageId.Value) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return Helpers.verifyWebLog<Page> webLogId (fun it -> it.WebLogId) (Map.toPage ser) rdr
return verifyWebLog<Page> webLogId (_.WebLogId) (Map.toPage ser) rdr
}
/// Find a complete page by its ID
@ -175,7 +175,7 @@ type SQLitePageData (conn : SqliteConnection, ser : JsonSerializer) =
match! findById pageId webLogId with
| Some _ ->
use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore
cmd.Parameters.AddWithValue ("@id", pageId.Value) |> ignore
cmd.CommandText <-
"DELETE FROM page_revision WHERE page_id = @id;
DELETE FROM page_permalink WHERE page_id = @id;
@ -186,11 +186,11 @@ type SQLitePageData (conn : SqliteConnection, ser : JsonSerializer) =
}
/// Find a page by its permalink for the given web log
let findByPermalink permalink webLogId = backgroundTask {
let findByPermalink (permalink: Permalink) webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId AND permalink = @link"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@link", Permalink.toString permalink) |> ignore
cmd.Parameters.AddWithValue ("@link", permalink.Value) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return if rdr.Read () then Some (toPage rdr) else None
}
@ -198,7 +198,7 @@ type SQLitePageData (conn : SqliteConnection, ser : JsonSerializer) =
/// Find the current permalink within a set of potential prior permalinks for the given web log
let findCurrentPermalink permalinks webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
let linkSql, linkParams = inClause "AND pp.permalink" "link" Permalink.toString permalinks
let linkSql, linkParams = inClause "AND pp.permalink" "link" (fun (it: Permalink) -> it.Value) permalinks
cmd.CommandText <- $"
SELECT p.permalink
FROM page p

60
src/MyWebLog.Data/SQLite/SQLitePostData.fs
View File

@ -14,12 +14,12 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
/// Add parameters for post INSERT or UPDATE statements
let addPostParameters (cmd: SqliteCommand) (post: Post) =
[ cmd.Parameters.AddWithValue ("@id", PostId.toString post.Id)
[ cmd.Parameters.AddWithValue ("@id", post.Id.Value)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString post.WebLogId)
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString post.AuthorId)
cmd.Parameters.AddWithValue ("@status", PostStatus.toString post.Status)
cmd.Parameters.AddWithValue ("@status", post.Status.Value)
cmd.Parameters.AddWithValue ("@title", post.Title)
cmd.Parameters.AddWithValue ("@permalink", Permalink.toString post.Permalink)
cmd.Parameters.AddWithValue ("@permalink", post.Permalink.Value)
cmd.Parameters.AddWithValue ("@publishedOn", maybeInstant post.PublishedOn)
cmd.Parameters.AddWithValue ("@updatedOn", instantParam post.UpdatedOn)
cmd.Parameters.AddWithValue ("@template", maybe post.Template)
@ -34,7 +34,7 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
/// Append category IDs and tags to a post
let appendPostCategoryAndTag (post: Post) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@id", PostId.toString post.Id) |> ignore
cmd.Parameters.AddWithValue ("@id", post.Id.Value) |> ignore
cmd.CommandText <- "SELECT category_id AS id FROM post_category WHERE post_id = @id"
use! rdr = cmd.ExecuteReaderAsync ()
@ -49,7 +49,7 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
/// Append revisions and permalinks to a post
let appendPostRevisionsAndPermalinks (post: Post) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@postId", PostId.toString post.Id) |> ignore
cmd.Parameters.AddWithValue ("@postId", post.Id.Value) |> ignore
cmd.CommandText <- "SELECT permalink FROM post_permalink WHERE post_id = @postId"
use! rdr = cmd.ExecuteReaderAsync ()
@ -69,12 +69,12 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
Map.toPost ser
/// Find just-the-post by its ID for the given web log (excludes category, tag, meta, revisions, and permalinks)
let findPostById postId webLogId = backgroundTask {
let findPostById (postId: PostId) webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- $"{selectPost} WHERE p.id = @id"
cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore
cmd.Parameters.AddWithValue ("@id", postId.Value) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return Helpers.verifyWebLog<Post> webLogId (fun p -> p.WebLogId) toPost rdr
return verifyWebLog<Post> webLogId (_.WebLogId) toPost rdr
}
/// Return a post with no revisions, prior permalinks, or text
@ -82,13 +82,13 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
{ toPost rdr with Text = "" }
/// Update a post's assigned categories
let updatePostCategories postId oldCats newCats = backgroundTask {
let updatePostCategories (postId: PostId) oldCats newCats = backgroundTask {
let toDelete, toAdd = Utils.diffLists<CategoryId, string> oldCats newCats _.Value
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
[ cmd.Parameters.AddWithValue ("@postId", postId.Value)
cmd.Parameters.Add ("@categoryId", SqliteType.Text)
] |> ignore
let runCmd (catId: CategoryId) = backgroundTask {
@ -108,13 +108,13 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
}
/// Update a post's assigned categories
let updatePostTags postId (oldTags : string list) newTags = backgroundTask {
let updatePostTags (postId: PostId) (oldTags: string list) newTags = backgroundTask {
let toDelete, toAdd = Utils.diffLists oldTags newTags id
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
[ cmd.Parameters.AddWithValue ("@postId", postId.Value)
cmd.Parameters.Add ("@tag", SqliteType.Text)
] |> ignore
let runCmd (tag: string) = backgroundTask {
@ -134,17 +134,17 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
}
/// Update a post's prior permalinks
let updatePostPermalinks postId oldLinks newLinks = backgroundTask {
let updatePostPermalinks (postId: PostId) oldLinks newLinks = backgroundTask {
let toDelete, toAdd = Utils.diffPermalinks oldLinks newLinks
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
[ cmd.Parameters.AddWithValue ("@postId", postId.Value)
cmd.Parameters.Add ("@link", SqliteType.Text)
] |> ignore
let runCmd link = backgroundTask {
cmd.Parameters["@link"].Value <- Permalink.toString link
let runCmd (link: Permalink) = backgroundTask {
cmd.Parameters["@link"].Value <- link.Value
do! write cmd
}
cmd.CommandText <- "DELETE FROM post_permalink WHERE post_id = @postId AND permalink = @link"
@ -160,7 +160,7 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
}
/// Update a post's revisions
let updatePostRevisions postId oldRevs newRevs = backgroundTask {
let updatePostRevisions (postId: PostId) oldRevs newRevs = backgroundTask {
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
@ -168,10 +168,10 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
use cmd = conn.CreateCommand ()
let runCmd withText rev = backgroundTask {
cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
[ cmd.Parameters.AddWithValue ("@postId", postId.Value)
cmd.Parameters.AddWithValue ("@asOf", instantParam rev.AsOf)
] |> ignore
if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.Text) |> ignore
if withText then cmd.Parameters.AddWithValue ("@text", rev.Text.Value) |> ignore
do! write cmd
}
cmd.CommandText <- "DELETE FROM post_revision WHERE post_id = @postId AND as_of = @asOf"
@ -208,11 +208,11 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
}
/// Count posts in a status for the given web log
let countByStatus status webLogId = backgroundTask {
let countByStatus (status: PostStatus) webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT COUNT(id) FROM post WHERE web_log_id = @webLogId AND status = @status"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@status", PostStatus.toString status) |> ignore
cmd.Parameters.AddWithValue ("@status", status.Value) |> ignore
return! count cmd
}
@ -226,11 +226,11 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
}
/// Find a post by its permalink for the given web log (excluding revisions and prior permalinks)
let findByPermalink permalink webLogId = backgroundTask {
let findByPermalink (permalink: Permalink) webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- $"{selectPost} WHERE p.web_log_id = @webLogId AND p.permalink = @link"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@link", Permalink.toString permalink) |> ignore
cmd.Parameters.AddWithValue ("@link", permalink.Value) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
if rdr.Read () then
let! post = appendPostCategoryAndTag (toPost rdr)
@ -253,7 +253,7 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
match! findFullById postId webLogId with
| Some _ ->
use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore
cmd.Parameters.AddWithValue ("@id", postId.Value) |> ignore
cmd.CommandText <-
"DELETE FROM post_revision WHERE post_id = @id;
DELETE FROM post_permalink WHERE post_id = @id;
@ -269,7 +269,7 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
/// Find the current permalink from a list of potential prior permalinks for the given web log
let findCurrentPermalink permalinks webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
let linkSql, linkParams = inClause "AND pp.permalink" "link" Permalink.toString permalinks
let linkSql, linkParams = inClause "AND pp.permalink" "link" (fun (it: Permalink) -> it.Value) permalinks
cmd.CommandText <- $"
SELECT p.permalink
FROM post p
@ -301,7 +301,7 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
/// Get a page of categorized posts for the given web log (excludes revisions and prior permalinks)
let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand ()
let catSql, catParams = inClause "AND pc.category_id" "catId" (_.Value) categoryIds
let catSql, catParams = inClause "AND pc.category_id" "catId" (fun (it: CategoryId) -> it.Value) categoryIds
cmd.CommandText <- $"
{selectPost}
INNER JOIN post_category pc ON pc.post_id = p.id
@ -311,7 +311,7 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
ORDER BY published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore
cmd.Parameters.AddWithValue ("@status", Published.Value) |> ignore
cmd.Parameters.AddRange catParams
use! rdr = cmd.ExecuteReaderAsync ()
let! posts =
@ -348,7 +348,7 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
ORDER BY p.published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore
cmd.Parameters.AddWithValue ("@status", Published.Value) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
let! posts =
toList toPost rdr
@ -369,7 +369,7 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
ORDER BY p.published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published)
[ cmd.Parameters.AddWithValue ("@status", Published.Value)
cmd.Parameters.AddWithValue ("@tag", tag)
] |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
@ -391,7 +391,7 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
ORDER BY p.published_on DESC
LIMIT 1"
addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published)
[ cmd.Parameters.AddWithValue ("@status", Published.Value)
cmd.Parameters.AddWithValue ("@publishedOn", instantParam publishedOn)
] |> ignore
use! rdr = cmd.ExecuteReaderAsync ()

4
src/MyWebLog.Data/SQLite/SQLiteUploadData.fs
View File

@ -12,7 +12,7 @@ type SQLiteUploadData (conn : SqliteConnection) =
let addUploadParameters (cmd : SqliteCommand) (upload : Upload) =
[ cmd.Parameters.AddWithValue ("@id", UploadId.toString upload.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString upload.WebLogId)
cmd.Parameters.AddWithValue ("@path", Permalink.toString upload.Path)
cmd.Parameters.AddWithValue ("@path", upload.Path.Value)
cmd.Parameters.AddWithValue ("@updatedOn", instantParam upload.UpdatedOn)
cmd.Parameters.AddWithValue ("@dataLength", upload.Data.Length)
] |> ignore
@ -53,7 +53,7 @@ type SQLiteUploadData (conn : SqliteConnection) =
do! rdr.CloseAsync ()
cmd.CommandText <- "DELETE FROM upload WHERE id = @id AND web_log_id = @webLogId"
do! write cmd
return Ok (Permalink.toString upload.Path)
return Ok upload.Path.Value
else
return Error $"""Upload ID {cmd.Parameters["@id"]} not found"""
}

2
src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs
View File

@ -46,7 +46,7 @@ type SQLiteWebLogData (conn : SqliteConnection, ser : JsonSerializer) =
[ cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString feed.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId)
cmd.Parameters.AddWithValue ("@source", CustomFeedSource.toString feed.Source)
cmd.Parameters.AddWithValue ("@path", Permalink.toString feed.Path)
cmd.Parameters.AddWithValue ("@path", feed.Path.Value)
cmd.Parameters.AddWithValue ("@podcast", maybe (if Option.isSome feed.Podcast then
Some (Utils.serialize ser feed.Podcast)
else None))

4
src/MyWebLog.Data/SQLiteData.fs
View File

@ -195,7 +195,7 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>, ser : JsonS
FundingUrl = Map.tryString "funding_url" podcastRdr
FundingText = Map.tryString "funding_text" podcastRdr
Medium = Map.tryString "medium" podcastRdr
|> Option.map PodcastMedium.parse
|> Option.map PodcastMedium.Parse
}
} |> List.ofSeq
podcastRdr.Close ()
@ -241,7 +241,7 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>, ser : JsonS
|> List.iter (fun (postId, episode) ->
cmd.CommandText <- "UPDATE post SET episode = @episode WHERE id = @id"
[ cmd.Parameters.AddWithValue ("@episode", Utils.serialize ser episode)
cmd.Parameters.AddWithValue ("@id", PostId.toString postId) ] |> ignore
cmd.Parameters.AddWithValue ("@id", postId.Value) ] |> ignore
let _ = cmd.ExecuteNonQuery ()
cmd.Parameters.Clear ())

4
src/MyWebLog.Data/Utils.fs
View File

@ -34,11 +34,11 @@ let diffMetaItems (oldItems : MetaItem list) newItems =
/// Find the permalinks added and removed
let diffPermalinks oldLinks newLinks =
diffLists oldLinks newLinks Permalink.toString
diffLists oldLinks newLinks (fun (it: Permalink) -> it.Value)
/// Find the revisions added and removed
let diffRevisions oldRevs newRevs =
diffLists oldRevs newRevs (fun (rev: Revision) -> $"{rev.AsOf.ToUnixTimeTicks()}|{MarkupText.toString rev.Text}")
diffLists oldRevs newRevs (fun (rev: Revision) -> $"{rev.AsOf.ToUnixTimeTicks()}|{rev.Text.Value}")
open MyWebLog.Converters
open Newtonsoft.Json

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

@ -77,7 +77,7 @@ module Comment =
/// An empty comment
let empty = {
Id = CommentId.Empty
PostId = PostId.empty
PostId = PostId.Empty
InReplyToId = None
Name = ""
Email = ""
@ -136,11 +136,11 @@ module Page =
/// An empty page
let empty = {
Id = PageId.empty
Id = PageId.Empty
WebLogId = WebLogId.empty
AuthorId = WebLogUserId.empty
Title = ""
Permalink = Permalink.empty
Permalink = Permalink.Empty
PublishedOn = Noda.epoch
UpdatedOn = Noda.epoch
IsInPageList = false
@ -209,12 +209,12 @@ module Post =
/// An empty post
let empty = {
Id = PostId.empty
Id = PostId.Empty
WebLogId = WebLogId.empty
AuthorId = WebLogUserId.empty
Status = Draft
Title = ""
Permalink = Permalink.empty
Permalink = Permalink.Empty
PublishedOn = None
UpdatedOn = Noda.epoch
Text = ""
@ -330,7 +330,7 @@ module Upload =
let empty = {
Id = UploadId.empty
WebLogId = WebLogId.empty
Path = Permalink.empty
Path = Permalink.Empty
UpdatedOn = Noda.epoch
Data = [||]
}
@ -406,13 +406,13 @@ module WebLog =
$"{scheme[0]}://{host[0]}", if host.Length > 1 then $"""/{String.Join("/", host |> Array.skip 1)}""" else ""
/// Generate an absolute URL for the given link
let absoluteUrl webLog permalink =
$"{webLog.UrlBase}/{Permalink.toString permalink}"
let absoluteUrl webLog (permalink: Permalink) =
$"{webLog.UrlBase}/{permalink.Value}"
/// Generate a relative URL for the given link
let relativeUrl webLog permalink =
let relativeUrl webLog (permalink: Permalink) =
let _, leadPath = hostAndPath webLog
$"{leadPath}/{Permalink.toString permalink}"
$"{leadPath}/{permalink.Value}"
/// Convert an Instant (UTC reference) to the web log's local date/time
let localTime webLog (date: Instant) =

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

@ -1,17 +1,23 @@
namespace MyWebLog
open System
open Markdig
open NodaTime
/// Support functions for domain definition
[<AutoOpen>]
module private Helpers =
open Markdown.ColorCode
/// Create a new ID (short GUID)
// https://www.madskristensen.net/blog/A-shorter-and-URL-friendly-GUID
let newId () =
Convert.ToBase64String(Guid.NewGuid().ToByteArray()).Replace('/', '_').Replace('+', '-')[..22]
/// Pipeline with most extensions enabled
let markdownPipeline = MarkdownPipelineBuilder().UseSmartyPants().UseAdvancedExtensions().UseColorCode().Build()
/// Functions to support NodaTime manipulation
module Noda =
@ -275,9 +281,6 @@ type Episode = {
this.Duration |> Option.map (DurationPattern.CreateWithInvariantCulture("H:mm:ss").Format)
open Markdig
open Markdown.ColorCode
/// Types of markup text
type MarkupText =
/// Markdown text
@ -285,31 +288,28 @@ type MarkupText =
/// HTML text
| Html of string
/// Functions to support markup text
module MarkupText =
/// Pipeline with most extensions enabled
let private _pipeline = MarkdownPipelineBuilder().UseSmartyPants().UseAdvancedExtensions().UseColorCode().Build()
/// Get the source type for the markup text
let sourceType = function Markdown _ -> "Markdown" | Html _ -> "HTML"
/// Get the raw text, regardless of type
let text = function Markdown text -> text | Html text -> text
/// Get the string representation of the markup text
let toString it = $"{sourceType it}: {text it}"
/// Get the HTML representation of the markup text
let toHtml = function Markdown text -> Markdown.ToHtml(text, _pipeline) | Html text -> text
/// Parse a string into a MarkupText instance
let parse (it : string) =
static member Parse(it: string) =
match it with
| text when text.StartsWith "Markdown: " -> Markdown text[10..]
| text when text.StartsWith "HTML: " -> Html text[6..]
| text -> invalidOp $"Cannot derive type of text ({text})"
/// The source type for the markup text
member this.SourceType =
match this with Markdown _ -> "Markdown" | Html _ -> "HTML"
/// The raw text, regardless of type
member this.Text =
match this with Markdown text -> text | Html text -> text
/// The string representation of the markup text
member this.Value = $"{this.SourceType}: {this.Text}"
/// The HTML representation of the markup text
member this.AsHtml() =
match this with Markdown text -> Markdown.ToHtml(text, markdownPipeline) | Html text -> text
/// An item of metadata
[<CLIMutable; NoComparison; NoEquality>]
@ -319,15 +319,13 @@ type MetaItem = {
/// The metadata value
Value : string
}
/// Functions to support metadata items
module MetaItem =
} with
/// An empty metadata item
let empty =
static member Empty =
{ Name = ""; Value = "" }
/// A revision of a page or post
[<CLIMutable; NoComparison; NoEquality>]
type Revision = {
@ -336,46 +334,45 @@ type Revision = {
/// The text of the revision
Text : MarkupText
}
/// Functions to support revisions
module Revision =
} with
/// An empty revision
let empty =
static member Empty =
{ AsOf = Noda.epoch; Text = Html "" }
/// A permanent link
type Permalink = Permalink of string
/// Functions to support permalinks
module Permalink =
[<Struct>]
type Permalink =
| Permalink of string
/// An empty permalink
let empty = Permalink ""
static member Empty = Permalink ""
/// Convert a permalink to a string
let toString = function Permalink p -> p
/// The string value of this permalink
member this.Value =
match this with Permalink it -> it
/// An identifier for a page
type PageId = PageId of string
/// Functions to support page IDs
module PageId =
[<Struct>]
type PageId =
| PageId of string
/// An empty page ID
let empty = PageId ""
/// Convert a page ID to a string
let toString = function PageId pi -> pi
static member Empty = PageId ""
/// Create a new page ID
let create = newId >> PageId
static member Create =
newId >> PageId
/// The string value of this page ID
member this.Value =
match this with PageId it -> it
/// PodcastIndex.org podcast:medium allowed values
[<Struct>]
type PodcastMedium =
| Podcast
| Music
@ -385,23 +382,9 @@ type PodcastMedium =
| Newsletter
| Blog
/// Functions to support podcast medium
module PodcastMedium =
/// Convert a podcast medium to a string
let toString =
function
| Podcast -> "podcast"
| Music -> "music"
| Video -> "video"
| Film -> "film"
| Audiobook -> "audiobook"
| Newsletter -> "newsletter"
| Blog -> "blog"
/// Parse a string into a podcast medium
let parse value =
match value with
static member Parse =
function
| "podcast" -> Podcast
| "music" -> Music
| "video" -> Video
@ -411,45 +394,57 @@ module PodcastMedium =
| "blog" -> Blog
| it -> invalidArg "medium" $"{it} is not a valid podcast medium"
/// The string value of this podcast medium
member this.Value =
match this with
| Podcast -> "podcast"
| Music -> "music"
| Video -> "video"
| Film -> "film"
| Audiobook -> "audiobook"
| Newsletter -> "newsletter"
| Blog -> "blog"
/// Statuses for posts
[<Struct>]
type PostStatus =
/// The post should not be publicly available
| Draft
/// The post is publicly viewable
| Published
/// Functions to support post statuses
module PostStatus =
/// Convert a post status to a string
let toString = function Draft -> "Draft" | Published -> "Published"
/// Parse a string into a post status
let parse value =
match value with
static member Parse =
function
| "Draft" -> Draft
| "Published" -> Published
| it -> invalidArg "status" $"{it} is not a valid post status"
/// The string representation of this post status
member this.Value =
match this with Draft -> "Draft" | Published -> "Published"
/// An identifier for a post
type PostId = PostId of string
/// Functions to support post IDs
module PostId =
[<Struct>]
type PostId =
| PostId of string
/// An empty post ID
let empty = PostId ""
/// Convert a post ID to a string
let toString = function PostId pi -> pi
static member Empty = PostId ""
/// Create a new post ID
let create = newId >> PostId
static member Create =
newId >> PostId
/// Convert a post ID to a string
member this.Value =
match this with PostId it -> it
/// A redirection for a previously valid URL
[<CLIMutable; NoComparison; NoEquality>]
type RedirectRule = {
/// The From string or pattern
From: string
@ -459,13 +454,10 @@ type RedirectRule = {
/// Whether to use regular expressions on this rule
IsRegex: bool
}
/// Functions to support redirect rules
module RedirectRule =
} with
/// An empty redirect rule
let empty = {
static member Empty = {
From = ""
To = ""
IsRegex = false

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

@ -96,7 +96,7 @@ module DisplayCustomFeed =
| Tag tag -> $"Tag: {tag}"
{ Id = CustomFeedId.toString feed.Id
Source = source
Path = Permalink.toString feed.Path
Path = feed.Path.Value
IsPodcast = Option.isSome feed.Podcast
}
@ -136,16 +136,15 @@ type DisplayPage =
}
/// Create a minimal display page (no text or metadata) from a database page
static member FromPageMinimal webLog (page : Page) =
let pageId = PageId.toString page.Id
{ Id = pageId
static member FromPageMinimal webLog (page: Page) = {
Id = page.Id.Value
AuthorId = WebLogUserId.toString page.AuthorId
Title = page.Title
Permalink = Permalink.toString page.Permalink
Permalink = page.Permalink.Value
PublishedOn = WebLog.localTime webLog page.PublishedOn
UpdatedOn = WebLog.localTime webLog page.UpdatedOn
IsInPageList = page.IsInPageList
IsDefault = pageId = webLog.DefaultPage
IsDefault = page.Id.Value = webLog.DefaultPage
Text = ""
Metadata = []
}
@ -153,15 +152,14 @@ type DisplayPage =
/// Create a display page from a database page
static member FromPage webLog (page : Page) =
let _, extra = WebLog.hostAndPath webLog
let pageId = PageId.toString page.Id
{ Id = pageId
{ Id = page.Id.Value
AuthorId = WebLogUserId.toString page.AuthorId
Title = page.Title
Permalink = Permalink.toString page.Permalink
Permalink = page.Permalink.Value
PublishedOn = WebLog.localTime webLog page.PublishedOn
UpdatedOn = WebLog.localTime webLog page.UpdatedOn
IsInPageList = page.IsInPageList
IsDefault = pageId = webLog.DefaultPage
IsDefault = page.Id.Value = webLog.DefaultPage
Text = addBaseToRelativeUrls extra page.Text
Metadata = page.Metadata
}
@ -187,7 +185,7 @@ module DisplayRevision =
let fromRevision webLog (rev : Revision) =
{ AsOf = rev.AsOf.ToDateTimeUtc ()
AsOfLocal = WebLog.localTime webLog rev.AsOf
Format = MarkupText.sourceType rev.Text
Format = rev.Text.SourceType
}
@ -253,7 +251,7 @@ module DisplayUpload =
/// Create a display uploaded file
let fromUpload webLog source (upload : Upload) =
let path = Permalink.toString upload.Path
let path = upload.Path.Value
let name = Path.GetFileName path
{ Id = UploadId.toString upload.Id
Name = name
@ -442,7 +440,7 @@ type EditCustomFeedModel =
Id = CustomFeedId.toString feed.Id
SourceType = match feed.Source with Category _ -> "category" | Tag _ -> "tag"
SourceValue = match feed.Source with Category (CategoryId catId) -> catId | Tag tag -> tag
Path = Permalink.toString feed.Path
Path = feed.Path.Value
}
match feed.Podcast with
| Some p ->
@ -454,7 +452,7 @@ type EditCustomFeedModel =
Summary = p.Summary
DisplayedAuthor = p.DisplayedAuthor
Email = p.Email
ImageUrl = Permalink.toString p.ImageUrl
ImageUrl = p.ImageUrl.Value
AppleCategory = p.AppleCategory
AppleSubcategory = defaultArg p.AppleSubcategory ""
Explicit = p.Explicit.Value
@ -462,10 +460,8 @@ type EditCustomFeedModel =
MediaBaseUrl = defaultArg p.MediaBaseUrl ""
FundingUrl = defaultArg p.FundingUrl ""
FundingText = defaultArg p.FundingText ""
PodcastGuid = p.PodcastGuid
|> Option.map (fun it -> it.ToString().ToLowerInvariant ())
|> Option.defaultValue ""
Medium = p.Medium |> Option.map PodcastMedium.toString |> Option.defaultValue ""
PodcastGuid = p.PodcastGuid |> Option.map _.ToString().ToLowerInvariant() |> Option.defaultValue ""
Medium = p.Medium |> Option.map _.Value |> Option.defaultValue ""
}
| None -> rss
@ -492,7 +488,7 @@ type EditCustomFeedModel =
PodcastGuid = noneIfBlank this.PodcastGuid |> Option.map Guid.Parse
FundingUrl = noneIfBlank this.FundingUrl
FundingText = noneIfBlank this.FundingText
Medium = noneIfBlank this.Medium |> Option.map PodcastMedium.parse
Medium = noneIfBlank this.Medium |> Option.map PodcastMedium.Parse
}
else
None
@ -530,8 +526,8 @@ type EditMyInfoModel =
/// View model to edit a page
[<CLIMutable; NoComparison; NoEquality>]
type EditPageModel =
{ /// The ID of the page being edited
type EditPageModel = {
/// The ID of the page being edited
PageId: string
/// The title of the page
@ -553,28 +549,28 @@ type EditPageModel =
Text: string
/// Names of metadata items
MetaNames : string[]
MetaNames: string array
/// Values of metadata items
MetaValues : string[]
}
MetaValues: string array
} with
/// Create an edit model from an existing page
static member fromPage (page: Page) =
let latest =
match page.Revisions |> List.sortByDescending (fun r -> r.AsOf) |> List.tryHead with
match page.Revisions |> List.sortByDescending _.AsOf |> List.tryHead with
| Some rev -> rev
| None -> Revision.empty
let page = if page.Metadata |> List.isEmpty then { page with Metadata = [ MetaItem.empty ] } else page
{ PageId = PageId.toString page.Id
| None -> Revision.Empty
let page = if page.Metadata |> List.isEmpty then { page with Metadata = [ MetaItem.Empty ] } else page
{ PageId = page.Id.Value
Title = page.Title
Permalink = Permalink.toString page.Permalink
Permalink = page.Permalink.Value
Template = defaultArg page.Template ""
IsShownInPageList = page.IsInPageList
Source = MarkupText.sourceType latest.Text
Text = MarkupText.text latest.Text
MetaNames = page.Metadata |> List.map (fun m -> m.Name) |> Array.ofList
MetaValues = page.Metadata |> List.map (fun m -> m.Value) |> Array.ofList
Source = latest.Text.SourceType
Text = latest.Text.Text
MetaNames = page.Metadata |> List.map _.Name |> Array.ofList
MetaValues = page.Metadata |> List.map _.Value |> Array.ofList
}
/// Whether this is a new page
@ -582,9 +578,9 @@ type EditPageModel =
/// Update a page with values from this model
member this.UpdatePage (page: Page) now =
let revision = { AsOf = now; Text = MarkupText.parse $"{this.Source}: {this.Text}" }
let revision = { AsOf = now; Text = MarkupText.Parse $"{this.Source}: {this.Text}" }
// Detect a permalink change, and add the prior one to the prior list
match Permalink.toString page.Permalink with
match page.Permalink.Value with
| "" -> page
| link when link = this.Permalink -> page
| _ -> { page with PriorPermalinks = page.Permalink :: page.PriorPermalinks }
@ -596,7 +592,7 @@ type EditPageModel =
UpdatedOn = now
IsInPageList = this.IsShownInPageList
Template = match this.Template with "" -> None | tmpl -> Some tmpl
Text = MarkupText.toHtml revision.Text
Text = revision.Text.AsHtml()
Metadata = Seq.zip this.MetaNames this.MetaValues
|> Seq.filter (fun it -> fst it > "")
|> Seq.map (fun it -> { Name = fst it; Value = snd it })
@ -610,8 +606,8 @@ type EditPageModel =
/// View model to edit a post
[<CLIMutable; NoComparison; NoEquality>]
type EditPostModel =
{ /// The ID of the post being edited
type EditPostModel = {
/// The ID of the post being edited
PostId: string
/// The title of the post
@ -633,7 +629,7 @@ type EditPostModel =
Template: string
/// The category IDs for the post
CategoryIds : string[]
CategoryIds: string array
/// The post status
Status: string
@ -642,10 +638,10 @@ type EditPostModel =
DoPublish: bool
/// Names of metadata items
MetaNames : string[]
MetaNames: string array
/// Values of metadata items
MetaValues : string[]
MetaValues: string array
/// Whether to override the published date/time
SetPublished: bool
@ -709,28 +705,28 @@ type EditPostModel =
/// A description of this episode (optional, ignored if episode number is not provided)
EpisodeDescription: string
}
} with
/// Create an edit model from an existing past
static member fromPost webLog (post: Post) =
let latest =
match post.Revisions |> List.sortByDescending (_.AsOf) |> List.tryHead with
match post.Revisions |> List.sortByDescending _.AsOf |> List.tryHead with
| Some rev -> rev
| None -> Revision.empty
let post = if post.Metadata |> List.isEmpty then { post with Metadata = [ MetaItem.empty ] } else post
| None -> Revision.Empty
let post = if post.Metadata |> List.isEmpty then { post with Metadata = [ MetaItem.Empty ] } else post
let episode = defaultArg post.Episode Episode.Empty
{ PostId = PostId.toString post.Id
{ PostId = post.Id.Value
Title = post.Title
Permalink = Permalink.toString post.Permalink
Source = MarkupText.sourceType latest.Text
Text = MarkupText.text latest.Text
Permalink = post.Permalink.Value
Source = latest.Text.SourceType
Text = latest.Text.Text
Tags = String.Join (", ", post.Tags)
Template = defaultArg post.Template ""
CategoryIds = post.CategoryIds |> List.map (_.Value) |> Array.ofList
Status = PostStatus.toString post.Status
CategoryIds = post.CategoryIds |> List.map _.Value |> Array.ofList
Status = post.Status.Value
DoPublish = false
MetaNames = post.Metadata |> List.map (_.Name) |> Array.ofList
MetaValues = post.Metadata |> List.map (_.Value) |> Array.ofList
MetaNames = post.Metadata |> List.map _.Name |> Array.ofList
MetaValues = post.Metadata |> List.map _.Value |> Array.ofList
SetPublished = false
PubOverride = post.PublishedOn |> Option.map (WebLog.localTime webLog) |> Option.toNullable
SetUpdated = false
@ -741,7 +737,7 @@ type EditPostModel =
MediaType = defaultArg episode.MediaType ""
ImageUrl = defaultArg episode.ImageUrl ""
Subtitle = defaultArg episode.Subtitle ""
Explicit = defaultArg (episode.Explicit |> Option.map (_.Value)) ""
Explicit = defaultArg (episode.Explicit |> Option.map _.Value) ""
ChapterFile = defaultArg episode.ChapterFile ""
ChapterType = defaultArg episode.ChapterType ""
TranscriptUrl = defaultArg episode.TranscriptUrl ""
@ -759,9 +755,9 @@ type EditPostModel =
/// Update a post with values from the submitted form
member this.UpdatePost (post: Post) now =
let revision = { AsOf = now; Text = MarkupText.parse $"{this.Source}: {this.Text}" }
let revision = { AsOf = now; Text = MarkupText.Parse $"{this.Source}: {this.Text}" }
// Detect a permalink change, and add the prior one to the prior list
match Permalink.toString post.Permalink with
match post.Permalink.Value with
| "" -> post
| link when link = this.Permalink -> post
| _ -> { post with PriorPermalinks = post.Permalink :: post.PriorPermalinks }
@ -772,7 +768,7 @@ type EditPostModel =
Permalink = Permalink this.Permalink
PublishedOn = if this.DoPublish then Some now else post.PublishedOn
UpdatedOn = now
Text = MarkupText.toHtml revision.Text
Text = revision.Text.AsHtml()
Tags = this.Tags.Split ","
|> Seq.ofArray
|> Seq.map (fun it -> it.Trim().ToLower ())
@ -1005,8 +1001,8 @@ type LogOnModel =
/// View model to manage permalinks
[<CLIMutable; NoComparison; NoEquality>]
type ManagePermalinksModel =
{ /// The ID for the entity being edited
type ManagePermalinksModel = {
/// The ID for the entity being edited
Id: string
/// The type of entity being edited ("page" or "post")
@ -1019,25 +1015,25 @@ type ManagePermalinksModel =
CurrentPermalink: string
/// The prior permalinks for the page or post
Prior : string[]
}
Prior: string array
} with
/// Create a permalink model from a page
static member fromPage (pg: Page) =
{ Id = PageId.toString pg.Id
{ Id = pg.Id.Value
Entity = "page"
CurrentTitle = pg.Title
CurrentPermalink = Permalink.toString pg.Permalink
Prior = pg.PriorPermalinks |> List.map Permalink.toString |> Array.ofList
CurrentPermalink = pg.Permalink.Value
Prior = pg.PriorPermalinks |> List.map _.Value |> Array.ofList
}
/// Create a permalink model from a post
static member fromPost (post: Post) =
{ Id = PostId.toString post.Id
{ Id = post.Id.Value
Entity = "post"
CurrentTitle = post.Title
CurrentPermalink = Permalink.toString post.Permalink
Prior = post.PriorPermalinks |> List.map Permalink.toString |> Array.ofList
CurrentPermalink = post.Permalink.Value
Prior = post.PriorPermalinks |> List.map _.Value |> Array.ofList
}
@ -1054,12 +1050,12 @@ type ManageRevisionsModel =
CurrentTitle : string
/// The revisions for the page or post
Revisions : DisplayRevision[]
Revisions : DisplayRevision array
}
/// Create a revision model from a page
static member fromPage webLog (pg: Page) =
{ Id = PageId.toString pg.Id
{ Id = pg.Id.Value
Entity = "page"
CurrentTitle = pg.Title
Revisions = pg.Revisions |> List.map (DisplayRevision.fromRevision webLog) |> Array.ofList
@ -1067,7 +1063,7 @@ type ManageRevisionsModel =
/// Create a revision model from a post
static member fromPost webLog (post: Post) =
{ Id = PostId.toString post.Id
{ Id = post.Id.Value
Entity = "post"
CurrentTitle = post.Title
Revisions = post.Revisions |> List.map (DisplayRevision.fromRevision webLog) |> Array.ofList
@ -1076,8 +1072,8 @@ type ManageRevisionsModel =
/// View model for posts in a list
[<NoComparison; NoEquality>]
type PostListItem =
{ /// The ID of the post
type PostListItem = {
/// The ID of the post
Id: string
/// The ID of the user who authored the post
@ -1112,17 +1108,17 @@ type PostListItem =
/// Metadata for the post
Metadata: MetaItem list
}
} with
/// Create a post list item from a post
static member fromPost (webLog: WebLog) (post: Post) =
let _, extra = WebLog.hostAndPath webLog
let inTZ = WebLog.localTime webLog
{ Id = PostId.toString post.Id
{ Id = post.Id.Value
AuthorId = WebLogUserId.toString post.AuthorId
Status = PostStatus.toString post.Status
Status = post.Status.Value
Title = post.Title
Permalink = Permalink.toString post.Permalink
Permalink = post.Permalink.Value
PublishedOn = post.PublishedOn |> Option.map inTZ |> Option.toNullable
UpdatedOn = inTZ post.UpdatedOn
Text = addBaseToRelativeUrls extra post.Text

2
src/MyWebLog/DotLiquidBespoke.fs
View File

@ -127,7 +127,7 @@ type PageHeadTag () =
if webLog.Rss.IsFeedEnabled && getBool "is_home" then
result.WriteLine(feedLink webLog.Name webLog.Rss.FeedName)
result.WriteLine $"""{s}<link rel="canonical" href="{WebLog.absoluteUrl webLog Permalink.empty}">"""
result.WriteLine $"""{s}<link rel="canonical" href="{WebLog.absoluteUrl webLog Permalink.Empty}">"""
if webLog.Rss.IsCategoryEnabled && getBool "is_category_home" then
let slug = context.Environments[0].["slug"] :?> string

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

@ -233,7 +233,7 @@ module RedirectRules =
if idx = -1 then
return!
hashForPage "Add Redirect Rule"
|> addToHash "model" (EditRedirectRuleModel.fromRule -1 RedirectRule.empty)
|> addToHash "model" (EditRedirectRuleModel.fromRule -1 RedirectRule.Empty)
|> withAntiCsrf ctx
|> adminBareView "redirect-edit" next ctx
else
@ -260,7 +260,7 @@ module RedirectRules =
let! model = ctx.BindFormAsync<EditRedirectRuleModel> ()
let isNew = idx = -1
let rules = ctx.WebLog.RedirectRules
let rule = model.UpdateRule (if isNew then RedirectRule.empty else List.item idx rules)
let rule = model.UpdateRule (if isNew then RedirectRule.Empty else List.item idx rules)
let newRules =
match isNew with
| true when model.InsertAtTop -> List.insertAt 0 rule rules
@ -555,8 +555,8 @@ module WebLog =
seq {
KeyValuePair.Create("posts", "- First Page of Posts -")
yield! allPages
|> List.sortBy (fun p -> p.Title.ToLower ())
|> List.map (fun p -> KeyValuePair.Create (PageId.toString p.Id, p.Title))
|> List.sortBy _.Title.ToLower()
|> List.map (fun p -> KeyValuePair.Create(p.Id.Value, p.Title))
}
|> Array.ofSeq)
|> addToHash "themes" (

28
src/MyWebLog/Handlers/Feed.fs
View File

@ -37,13 +37,12 @@ let deriveFeedType (ctx : HttpContext) feedPath : (FeedType * int) option =
| false ->
// Category and tag feeds are handled by defined routes; check for custom feed
match webLog.Rss.CustomFeeds
|> List.tryFind (fun it -> feedPath.EndsWith (Permalink.toString it.Path)) with
|> List.tryFind (fun it -> feedPath.EndsWith it.Path.Value) with
| Some feed ->
debug (fun () -> "Found custom feed")
Some (Custom (feed, feedPath),
feed.Podcast |> Option.map (fun p -> p.ItemsInFeed) |> Option.defaultValue postCount)
Some (Custom (feed, feedPath), feed.Podcast |> Option.map _.ItemsInFeed |> Option.defaultValue postCount)
| None ->
debug (fun () -> $"No matching feed found")
debug (fun () -> "No matching feed found")
None
/// Determine the function to retrieve posts for the given feed
@ -142,7 +141,7 @@ let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (po
| link when Option.isSome podcast.MediaBaseUrl -> $"{podcast.MediaBaseUrl.Value}{link}"
| link -> WebLog.absoluteUrl webLog (Permalink link)
let epMediaType = [ episode.MediaType; podcast.DefaultMediaType ] |> List.tryFind Option.isSome |> Option.flatten
let epImageUrl = defaultArg episode.ImageUrl (Permalink.toString podcast.ImageUrl) |> toAbsolute webLog
let epImageUrl = defaultArg episode.ImageUrl podcast.ImageUrl.Value |> toAbsolute webLog
let epExplicit = (defaultArg episode.Explicit podcast.Explicit).Value
let xmlDoc = XmlDocument()
@ -310,8 +309,7 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
podcast.PodcastGuid
|> Option.iter (fun guid ->
rssFeed.ElementExtensions.Add("guid", Namespace.podcast, guid.ToString().ToLowerInvariant()))
podcast.Medium
|> Option.iter (fun med -> rssFeed.ElementExtensions.Add("medium", Namespace.podcast, PodcastMedium.toString med))
podcast.Medium |> Option.iter (fun med -> rssFeed.ElementExtensions.Add("medium", Namespace.podcast, med.Value))
/// Get the feed's self reference and non-feed link
let private selfAndLink webLog feedType ctx =
@ -370,7 +368,7 @@ let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backg
match podcast, post.Episode with
| Some feed, Some episode -> addEpisode webLog (Option.get feed.Podcast) episode post item
| Some _, _ ->
warn "Feed" ctx $"[{webLog.Name} {Permalink.toString self}] \"{stripHtml post.Title}\" has no media"
warn "Feed" ctx $"[{webLog.Name} {self.Value}] \"{stripHtml post.Title}\" has no media"
item
| _ -> item
@ -438,13 +436,13 @@ let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next
|> addToHash ViewContext.Model (EditCustomFeedModel.fromFeed f)
|> addToHash "medium_values" [|
KeyValuePair.Create("", "&ndash; Unspecified &ndash;")
KeyValuePair.Create (PodcastMedium.toString Podcast, "Podcast")
KeyValuePair.Create (PodcastMedium.toString Music, "Music")
KeyValuePair.Create (PodcastMedium.toString Video, "Video")
KeyValuePair.Create (PodcastMedium.toString Film, "Film")
KeyValuePair.Create (PodcastMedium.toString Audiobook, "Audiobook")
KeyValuePair.Create (PodcastMedium.toString Newsletter, "Newsletter")
KeyValuePair.Create (PodcastMedium.toString Blog, "Blog")
KeyValuePair.Create(Podcast.Value, "Podcast")
KeyValuePair.Create(Music.Value, "Music")
KeyValuePair.Create(Video.Value, "Video")
KeyValuePair.Create(Film.Value, "Film")
KeyValuePair.Create(Audiobook.Value, "Audiobook")
KeyValuePair.Create(Newsletter.Value, "Newsletter")
KeyValuePair.Create(Blog.Value, "Blog")
|]
|> adminView "custom-feed-edit" next ctx
| None -> Error.notFound next ctx

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

@ -133,7 +133,7 @@ let previewRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun
return! {|
content =
[ """<div class="mwl-revision-preview mb-3">"""
(MarkupText.toHtml >> addBaseToRelativeUrls extra) rev.Text
rev.Text.AsHtml() |> addBaseToRelativeUrls extra
"</div>"
]
|> String.concat ""
@ -180,7 +180,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let tryPage =
if model.IsNew then
{ Page.empty with
Id = PageId.create ()
Id = PageId.Create()
WebLogId = ctx.WebLog.Id
AuthorId = ctx.UserId
PublishedOn = now
@ -193,7 +193,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
do! (if model.IsNew then data.Page.Add else data.Page.Update) updatedPage
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
return! redirectToGet $"admin/page/{page.Id.Value}/edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}

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

@ -58,7 +58,7 @@ let preparePostList webLog posts listType (url : string) pageNbr perPage (data :
| _ -> Task.FromResult (None, None)
let newerLink =
match listType, pageNbr with
| SinglePost, _ -> newerPost |> Option.map (fun p -> Permalink.toString p.Permalink)
| SinglePost, _ -> newerPost |> Option.map _.Permalink.Value
| _, 1 -> None
| PostList, 2 when webLog.DefaultPage = "posts" -> Some ""
| PostList, _ -> relUrl $"page/{pageNbr - 1}"
@ -70,7 +70,7 @@ let preparePostList webLog posts listType (url : string) pageNbr perPage (data :
| AdminList, _ -> relUrl $"admin/posts/page/{pageNbr - 1}"
let olderLink =
match listType, List.length posts > perPage with
| SinglePost, _ -> olderPost |> Option.map (fun p -> Permalink.toString p.Permalink)
| SinglePost, _ -> olderPost |> Option.map _.Permalink.Value
| _, false -> None
| PostList, true -> relUrl $"page/{pageNbr + 1}"
| CategoryList, true -> relUrl $"category/{url}/page/{pageNbr + 1}"
@ -81,9 +81,9 @@ let preparePostList webLog posts listType (url : string) pageNbr perPage (data :
Authors = authors
Subtitle = None
NewerLink = newerLink
NewerName = newerPost |> Option.map (fun p -> p.Title)
NewerName = newerPost |> Option.map _.Title
OlderLink = olderLink
OlderName = olderPost |> Option.map (fun p -> p.Title)
OlderName = olderPost |> Option.map _.Title
}
return
makeHash {||}
@ -333,7 +333,7 @@ let previewRevision (postId, revDate) : HttpHandler = requireAccess Author >=> f
return! {|
content =
[ """<div class="mwl-revision-preview mb-3">"""
(MarkupText.toHtml >> addBaseToRelativeUrls extra) rev.Text
rev.Text.AsHtml() |> addBaseToRelativeUrls extra
"</div>"
]
|> String.concat ""
@ -379,7 +379,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let tryPost =
if model.IsNew then
{ Post.empty with
Id = PostId.create ()
Id = PostId.Create()
WebLogId = ctx.WebLog.Id
AuthorId = ctx.UserId
} |> someTask
@ -410,7 +410,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|> List.length = List.length priorCats) then
do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.success with Message = "Post saved successfully" }
return! redirectToGet $"admin/post/{PostId.toString post.Id}/edit" next ctx
return! redirectToGet $"admin/post/{post.Id.Value}/edit" next ctx
| Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx
}

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

@ -23,8 +23,8 @@ module CatchAll =
seq {
debug (fun () -> $"Considering URL {textLink}")
// Home page directory without the directory slash
if textLink = "" then yield redirectTo true (WebLog.relativeUrl webLog Permalink.empty)
let permalink = Permalink (textLink.Substring 1)
if textLink = "" then yield redirectTo true (WebLog.relativeUrl webLog Permalink.Empty)
let permalink = Permalink textLink[1..]
// Current post
match data.Post.FindByPermalink permalink webLog.Id |> await with
| Some post ->

12
src/MyWebLog/Maintenance.fs
View File

@ -23,7 +23,7 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
// Create the web log
let webLogId = WebLogId.create ()
let userId = WebLogUserId.create ()
let homePageId = PageId.create ()
let homePageId = PageId.Create()
let slug = Handlers.Upload.makeSlug args[2]
// If this is the first web log being created, the user will be an installation admin; otherwise, they will be an
@ -37,7 +37,7 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task {
Name = args[2]
Slug = slug
UrlBase = args[1]
DefaultPage = PageId.toString homePageId
DefaultPage = homePageId.Value
TimeZone = timeZone
}
@ -110,8 +110,8 @@ let private importPriorPermalinks urlBase file (sp : IServiceProvider) = task {
let! withLinks = data.Post.FindFullById post.Id post.WebLogId
let! _ = data.Post.UpdatePriorPermalinks post.Id post.WebLogId
(old :: withLinks.Value.PriorPermalinks)
printfn $"{Permalink.toString old} -> {Permalink.toString current}"
| None -> eprintfn $"Cannot find current post for {Permalink.toString current}"
printfn $"{old.Value} -> {current.Value}"
| None -> eprintfn $"Cannot find current post for {current.Value}"
printfn "Done!"
| None -> eprintfn $"No web log found at {urlBase}"
}
@ -336,8 +336,8 @@ module Backup =
let newWebLogId = WebLogId.create ()
let newCatIds = archive.Categories |> List.map (fun cat -> cat.Id, CategoryId.Create ()) |> dict
let newMapIds = archive.TagMappings |> List.map (fun tm -> tm.Id, TagMapId.create ()) |> dict
let newPageIds = archive.Pages |> List.map (fun page -> page.Id, PageId.create ()) |> dict
let newPostIds = archive.Posts |> List.map (fun post -> post.Id, PostId.create ()) |> dict
let newPageIds = archive.Pages |> List.map (fun page -> page.Id, PageId.Create ()) |> dict
let newPostIds = archive.Posts |> List.map (fun post -> post.Id, PostId.Create ()) |> dict
let newUserIds = archive.Users |> List.map (fun user -> user.Id, WebLogUserId.create ()) |> dict
let newUpIds = archive.Uploads |> List.map (fun up -> up.Id, UploadId.create ()) |> dict
return