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

WIP on module/member conversion

Browse Source
This commit is contained in:
Daniel J. Summers 2023-12-15 22:46:12 -05:00
parent 7071d606f1
commit 5fe2077974
24 changed files with 548 additions and 565 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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

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

@ -33,7 +33,7 @@ type PostgresCategoryData (log : ILogger) =
let catIdSql, catIdParams = let catIdSql, catIdParams =
ordered ordered
|> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name) |> 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) |> Seq.append (Seq.singleton it.Id)
|> List.ofSeq |> List.ofSeq
|> arrayContains (nameof Post.empty.CategoryIds) id |> arrayContains (nameof Post.empty.CategoryIds) id
@ -43,10 +43,9 @@ type PostgresCategoryData (log : ILogger) =
FROM {Table.Post} FROM {Table.Post}
WHERE {Query.whereDataContains "@criteria"} WHERE {Query.whereDataContains "@criteria"}
AND {catIdSql}""" AND {catIdSql}"""
[ "@criteria", [ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Status = Published.Value |}
Query.jsonbDocParam {| webLogDoc webLogId with Status = PostStatus.toString Published |} catIdParams ]
catIdParams Map.toCount
] Map.toCount
|> Async.AwaitTask |> Async.AwaitTask
|> Async.RunSynchronously |> Async.RunSynchronously
it.Id, postCount) it.Id, postCount)
@ -107,7 +106,7 @@ type PostgresCategoryData (log : ILogger) =
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
Query.Update.partialById Table.Post, Query.Update.partialById Table.Post,
posts |> List.map (fun post -> [ posts |> List.map (fun post -> [
"@id", Sql.string (PostId.toString post.Id) "@id", Sql.string post.Id.Value
"@data", Query.jsonbDocParam "@data", Query.jsonbDocParam
{| CategoryIds = post.CategoryIds |> List.filter (fun cat -> cat <> catId) |} {| 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 /// Create a revision from the current row
let toRevision (row : RowReader) : Revision = let toRevision (row : RowReader) : Revision =
{ AsOf = row.fieldValue<Instant> "as_of" { 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 /// Create a theme asset from the current row
@ -206,7 +206,7 @@ module Revisions =
let revParams<'TKey> (key : 'TKey) (keyFunc : 'TKey -> string) rev = [ let revParams<'TKey> (key : 'TKey) (keyFunc : 'TKey -> string) rev = [
typedParam "asOf" rev.AsOf typedParam "asOf" rev.AsOf
"@id", Sql.string (keyFunc key) "@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 /// 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 /// Append revisions to a page
let appendPageRevisions (page: Page) = backgroundTask { let appendPageRevisions (page: Page) = backgroundTask {
log.LogTrace "Page.appendPageRevisions" 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 } return { page with Revisions = revisions }
} }
@ -23,14 +23,14 @@ type PostgresPageData (log : ILogger) =
{ fromData<Page> row with Text = "" } { fromData<Page> row with Text = "" }
/// Update a page's revisions /// Update a page's revisions
let updatePageRevisions pageId oldRevs newRevs = let updatePageRevisions (pageId: PageId) oldRevs newRevs =
log.LogTrace "Page.updatePageRevisions" 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? /// Does the given page exist?
let pageExists pageId webLogId = let pageExists (pageId: PageId) webLogId =
log.LogTrace "Page.pageExists" log.LogTrace "Page.pageExists"
Document.existsByWebLog Table.Page pageId PageId.toString webLogId Document.existsByWebLog Table.Page pageId (_.Value) webLogId
// IMPLEMENTATION FUNCTIONS // IMPLEMENTATION FUNCTIONS
@ -51,9 +51,9 @@ type PostgresPageData (log : ILogger) =
Count.byContains Table.Page {| webLogDoc webLogId with IsInPageList = true |} Count.byContains Table.Page {| webLogDoc webLogId with IsInPageList = true |}
/// Find a page by its ID (without revisions) /// Find a page by its ID (without revisions)
let findById pageId webLogId = let findById (pageId: PageId) webLogId =
log.LogTrace "Page.findById" 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 /// Find a complete page by its ID
let findFullById pageId webLogId = backgroundTask { let findFullById pageId webLogId = backgroundTask {
@ -70,15 +70,15 @@ type PostgresPageData (log : ILogger) =
log.LogTrace "Page.delete" log.LogTrace "Page.delete"
match! pageExists pageId webLogId with match! pageExists pageId webLogId with
| true -> | true ->
do! Delete.byId Table.Page (PageId.toString pageId) do! Delete.byId Table.Page pageId.Value
return true return true
| false -> return false | false -> return false
} }
/// Find a page by its permalink for the given web log /// Find a page by its permalink for the given web log
let findByPermalink permalink webLogId = let findByPermalink (permalink: Permalink) webLogId =
log.LogTrace "Page.findByPermalink" 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 |> tryHead
/// Find the current permalink within a set of potential prior permalinks for the given web log /// 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 if List.isEmpty permalinks then return None
else else
let linkSql, linkParam = let linkSql, linkParam =
arrayContains (nameof Page.empty.PriorPermalinks) Permalink.toString permalinks arrayContains (nameof Page.empty.PriorPermalinks) (fun (it: Permalink) -> it.Value) permalinks
return! return!
Custom.single Custom.single
$"""SELECT data ->> '{nameof Page.empty.Permalink}' AS permalink $"""SELECT data ->> '{nameof Page.empty.Permalink}' AS permalink
@ -134,9 +134,9 @@ type PostgresPageData (log : ILogger) =
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
Query.insert Table.Page, Query.insert Table.Page,
pages 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.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" log.LogTrace "Page.updatePriorPermalinks"
match! pageExists pageId webLogId with match! pageExists pageId webLogId with
| true -> | true ->
do! Update.partialById Table.Page (PageId.toString pageId) {| PriorPermalinks = permalinks |} do! Update.partialById Table.Page pageId.Value {| PriorPermalinks = permalinks |}
return true return true
| false -> return false | 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 /// Append revisions to a post
let appendPostRevisions (post: Post) = backgroundTask { let appendPostRevisions (post: Post) = backgroundTask {
log.LogTrace "Post.appendPostRevisions" 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 } return { post with Revisions = revisions }
} }
@ -24,34 +24,33 @@ type PostgresPostData (log : ILogger) =
{ fromData<Post> row with Text = "" } { fromData<Post> row with Text = "" }
/// Update a post's revisions /// Update a post's revisions
let updatePostRevisions postId oldRevs newRevs = let updatePostRevisions (postId: PostId) oldRevs newRevs =
log.LogTrace "Post.updatePostRevisions" 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? /// Does the given post exist?
let postExists postId webLogId = let postExists (postId: PostId) webLogId =
log.LogTrace "Post.postExists" log.LogTrace "Post.postExists"
Document.existsByWebLog Table.Post postId PostId.toString webLogId Document.existsByWebLog Table.Post postId (_.Value) webLogId
// IMPLEMENTATION FUNCTIONS // IMPLEMENTATION FUNCTIONS
/// Count posts in a status for the given web log /// Count posts in a status for the given web log
let countByStatus status webLogId = let countByStatus (status: PostStatus) webLogId =
log.LogTrace "Post.countByStatus" 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) /// Find a post by its ID for the given web log (excluding revisions)
let findById postId webLogId = let findById postId webLogId =
log.LogTrace "Post.findById" 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) /// 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" log.LogTrace "Post.findByPermalink"
Custom.single (selectWithCriteria Table.Post) Custom.single (selectWithCriteria Table.Post)
[ "@criteria", [ "@criteria", Query.jsonbDocParam {| webLogDoc webLogId with Permalink = permalink.Value |} ]
Query.jsonbDocParam {| webLogDoc webLogId with Permalink = Permalink.toString permalink |} fromData<Post>
] fromData<Post>
/// Find a complete post by its ID for the given web log /// Find a complete post by its ID for the given web log
let findFullById postId webLogId = backgroundTask { let findFullById postId webLogId = backgroundTask {
@ -68,11 +67,10 @@ type PostgresPostData (log : ILogger) =
log.LogTrace "Post.delete" log.LogTrace "Post.delete"
match! postExists postId webLogId with match! postExists postId webLogId with
| true -> | true ->
let theId = PostId.toString postId
do! Custom.nonQuery do! Custom.nonQuery
$"""DELETE FROM {Table.PostComment} WHERE {Query.whereDataContains "@criteria"}; $"""DELETE FROM {Table.PostComment} WHERE {Query.whereDataContains "@criteria"};
DELETE FROM {Table.Post} WHERE id = @id""" 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 return true
| false -> return false | false -> return false
} }
@ -83,7 +81,7 @@ type PostgresPostData (log : ILogger) =
if List.isEmpty permalinks then return None if List.isEmpty permalinks then return None
else else
let linkSql, linkParam = let linkSql, linkParam =
arrayContains (nameof Post.empty.PriorPermalinks) Permalink.toString permalinks arrayContains (nameof Post.empty.PriorPermalinks) (fun (it: Permalink) -> it.Value) permalinks
return! return!
Custom.single Custom.single
$"""SELECT data ->> '{nameof Post.empty.Permalink}' AS permalink $"""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) /// Get a page of categorized posts for the given web log (excludes revisions)
let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage =
log.LogTrace "Post.findPageOfCategorizedPosts" 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 Custom.list
$"{selectWithCriteria Table.Post} $"{selectWithCriteria Table.Post}
AND {catSql} AND {catSql}
ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" 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 catParam
] fromData<Post> ] fromData<Post>
@ -133,7 +132,7 @@ type PostgresPostData (log : ILogger) =
$"{selectWithCriteria Table.Post} $"{selectWithCriteria Table.Post}
ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" 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> fromData<Post>
/// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks) /// 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 AND data['{nameof Post.empty.Tags}'] @> @tag
ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC ORDER BY data ->> '{nameof Post.empty.PublishedOn}' DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" 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 |] "@tag", Query.jsonbDocParam [| tag |]
] fromData<Post> ] fromData<Post>
@ -152,7 +151,7 @@ type PostgresPostData (log : ILogger) =
let findSurroundingPosts webLogId publishedOn = backgroundTask { let findSurroundingPosts webLogId publishedOn = backgroundTask {
log.LogTrace "Post.findSurroundingPosts" log.LogTrace "Post.findSurroundingPosts"
let queryParams () = [ 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)) "@publishedOn", Sql.string ((InstantPattern.General.Format publishedOn).Substring (0, 19))
] ]
let pubField = nameof Post.empty.PublishedOn let pubField = nameof Post.empty.PublishedOn
@ -188,10 +187,9 @@ type PostgresPostData (log : ILogger) =
|> Sql.fromDataSource |> Sql.fromDataSource
|> Sql.executeTransactionAsync [ |> Sql.executeTransactionAsync [
Query.insert Table.Post, Query.insert Table.Post,
posts posts |> List.map (fun post -> Query.docParameters post.Id.Value { post with Revisions = [] })
|> List.map (fun post -> Query.docParameters (PostId.toString post.Id) { post with Revisions = [] })
Revisions.insertSql Table.PostRevision, 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" log.LogTrace "Post.updatePriorPermalinks"
match! postExists postId webLogId with match! postExists postId webLogId with
| true -> | true ->
do! Update.partialById Table.Post (PostId.toString postId) {| PriorPermalinks = permalinks |} do! Update.partialById Table.Post postId.Value {| PriorPermalinks = permalinks |}
return true return true
| false -> return false | false -> return false
} }

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

@ -22,7 +22,7 @@ type PostgresUploadData (log : ILogger) =
webLogIdParam upload.WebLogId webLogIdParam upload.WebLogId
typedParam "updatedOn" upload.UpdatedOn typedParam "updatedOn" upload.UpdatedOn
"@id", Sql.string (UploadId.toString upload.Id) "@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 "@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 delete
write; withRetryDefault; ignoreResult conn 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" | 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 Id = getString "id" rdr |> PostId
WebLogId = getString "web_log_id" rdr |> WebLogId WebLogId = getString "web_log_id" rdr |> WebLogId
AuthorId = getString "author_id" rdr |> WebLogUserId AuthorId = getString "author_id" rdr |> WebLogUserId
Status = getString "status" rdr |> PostStatus.parse Status = getString "status" rdr |> PostStatus.Parse
Title = getString "title" rdr Title = getString "title" rdr
Permalink = toPermalink rdr Permalink = toPermalink rdr
PublishedOn = tryInstant "published_on" rdr PublishedOn = tryInstant "published_on" rdr
@ -270,7 +270,7 @@ module Map =
/// Create a revision from the current row in the given data reader /// Create a revision from the current row in the given data reader
let toRevision rdr : Revision = let toRevision rdr : Revision =
{ AsOf = getInstant "as_of" rdr { 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 /// 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 /// Add parameters for page INSERT or UPDATE statements
let addPageParameters (cmd: SqliteCommand) (page: Page) = 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 ("@webLogId", WebLogId.toString page.WebLogId)
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString page.AuthorId) cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString page.AuthorId)
cmd.Parameters.AddWithValue ("@title", page.Title) 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 ("@publishedOn", instantParam page.PublishedOn)
cmd.Parameters.AddWithValue ("@updatedOn", instantParam page.UpdatedOn) cmd.Parameters.AddWithValue ("@updatedOn", instantParam page.UpdatedOn)
cmd.Parameters.AddWithValue ("@isInPageList", page.IsInPageList) cmd.Parameters.AddWithValue ("@isInPageList", page.IsInPageList)
@ -30,7 +30,7 @@ type SQLitePageData (conn : SqliteConnection, ser : JsonSerializer) =
/// Append revisions and permalinks to a page /// Append revisions and permalinks to a page
let appendPageRevisionsAndPermalinks (page : Page) = backgroundTask { let appendPageRevisionsAndPermalinks (page : Page) = backgroundTask {
use cmd = conn.CreateCommand () 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" cmd.CommandText <- "SELECT permalink FROM page_permalink WHERE page_id = @pageId"
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
@ -51,17 +51,17 @@ type SQLitePageData (conn : SqliteConnection, ser : JsonSerializer) =
{ toPage rdr with Text = "" } { toPage rdr with Text = "" }
/// Update a page's prior permalinks /// 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 let toDelete, toAdd = Utils.diffPermalinks oldLinks newLinks
if List.isEmpty toDelete && List.isEmpty toAdd then if List.isEmpty toDelete && List.isEmpty toAdd then
return () return ()
else else
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId) [ cmd.Parameters.AddWithValue ("@pageId", pageId.Value)
cmd.Parameters.Add ("@link", SqliteType.Text) cmd.Parameters.Add ("@link", SqliteType.Text)
] |> ignore ] |> ignore
let runCmd link = backgroundTask { let runCmd (link: Permalink) = backgroundTask {
cmd.Parameters["@link"].Value <- Permalink.toString link cmd.Parameters["@link"].Value <- link.Value
do! write cmd do! write cmd
} }
cmd.CommandText <- "DELETE FROM page_permalink WHERE page_id = @pageId AND permalink = @link" 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 /// 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 let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
if List.isEmpty toDelete && List.isEmpty toAdd then if List.isEmpty toDelete && List.isEmpty toAdd then
return () return ()
@ -85,10 +85,10 @@ type SQLitePageData (conn : SqliteConnection, ser : JsonSerializer) =
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
let runCmd withText rev = backgroundTask { let runCmd withText rev = backgroundTask {
cmd.Parameters.Clear () cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId) [ cmd.Parameters.AddWithValue ("@pageId", pageId.Value)
cmd.Parameters.AddWithValue ("@asOf", instantParam rev.AsOf) cmd.Parameters.AddWithValue ("@asOf", instantParam rev.AsOf)
] |> ignore ] |> 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 do! write cmd
} }
cmd.CommandText <- "DELETE FROM page_revision WHERE page_id = @pageId AND as_of = @asOf" 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) /// 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 () use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM page WHERE id = @id" 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 () 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 /// Find a complete page by its ID
@ -175,7 +175,7 @@ type SQLitePageData (conn : SqliteConnection, ser : JsonSerializer) =
match! findById pageId webLogId with match! findById pageId webLogId with
| Some _ -> | Some _ ->
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore cmd.Parameters.AddWithValue ("@id", pageId.Value) |> ignore
cmd.CommandText <- cmd.CommandText <-
"DELETE FROM page_revision WHERE page_id = @id; "DELETE FROM page_revision WHERE page_id = @id;
DELETE FROM page_permalink 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 /// 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 () use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId AND permalink = @link" cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId AND permalink = @link"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@link", Permalink.toString permalink) |> ignore cmd.Parameters.AddWithValue ("@link", permalink.Value) |> ignore
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
return if rdr.Read () then Some (toPage rdr) else None 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 /// Find the current permalink within a set of potential prior permalinks for the given web log
let findCurrentPermalink permalinks webLogId = backgroundTask { let findCurrentPermalink permalinks webLogId = backgroundTask {
use cmd = conn.CreateCommand () 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 <- $" cmd.CommandText <- $"
SELECT p.permalink SELECT p.permalink
FROM page p 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 /// Add parameters for post INSERT or UPDATE statements
let addPostParameters (cmd: SqliteCommand) (post: Post) = 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 ("@webLogId", WebLogId.toString post.WebLogId)
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString post.AuthorId) 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 ("@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 ("@publishedOn", maybeInstant post.PublishedOn)
cmd.Parameters.AddWithValue ("@updatedOn", instantParam post.UpdatedOn) cmd.Parameters.AddWithValue ("@updatedOn", instantParam post.UpdatedOn)
cmd.Parameters.AddWithValue ("@template", maybe post.Template) 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 /// Append category IDs and tags to a post
let appendPostCategoryAndTag (post: Post) = backgroundTask { let appendPostCategoryAndTag (post: Post) = backgroundTask {
use cmd = conn.CreateCommand () 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" cmd.CommandText <- "SELECT category_id AS id FROM post_category WHERE post_id = @id"
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
@ -49,7 +49,7 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
/// Append revisions and permalinks to a post /// Append revisions and permalinks to a post
let appendPostRevisionsAndPermalinks (post: Post) = backgroundTask { let appendPostRevisionsAndPermalinks (post: Post) = backgroundTask {
use cmd = conn.CreateCommand () 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" cmd.CommandText <- "SELECT permalink FROM post_permalink WHERE post_id = @postId"
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
@ -69,12 +69,12 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
Map.toPost ser Map.toPost ser
/// Find just-the-post by its ID for the given web log (excludes category, tag, meta, revisions, and permalinks) /// 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 () use cmd = conn.CreateCommand ()
cmd.CommandText <- $"{selectPost} WHERE p.id = @id" 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 () 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 /// Return a post with no revisions, prior permalinks, or text
@ -82,13 +82,13 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
{ toPost rdr with Text = "" } { toPost rdr with Text = "" }
/// Update a post's assigned categories /// 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 let toDelete, toAdd = Utils.diffLists<CategoryId, string> oldCats newCats _.Value
if List.isEmpty toDelete && List.isEmpty toAdd then if List.isEmpty toDelete && List.isEmpty toAdd then
return () return ()
else else
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId) [ cmd.Parameters.AddWithValue ("@postId", postId.Value)
cmd.Parameters.Add ("@categoryId", SqliteType.Text) cmd.Parameters.Add ("@categoryId", SqliteType.Text)
] |> ignore ] |> ignore
let runCmd (catId: CategoryId) = backgroundTask { let runCmd (catId: CategoryId) = backgroundTask {
@ -108,13 +108,13 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
} }
/// Update a post's assigned categories /// 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 let toDelete, toAdd = Utils.diffLists oldTags newTags id
if List.isEmpty toDelete && List.isEmpty toAdd then if List.isEmpty toDelete && List.isEmpty toAdd then
return () return ()
else else
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId) [ cmd.Parameters.AddWithValue ("@postId", postId.Value)
cmd.Parameters.Add ("@tag", SqliteType.Text) cmd.Parameters.Add ("@tag", SqliteType.Text)
] |> ignore ] |> ignore
let runCmd (tag: string) = backgroundTask { let runCmd (tag: string) = backgroundTask {
@ -134,17 +134,17 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
} }
/// Update a post's prior permalinks /// 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 let toDelete, toAdd = Utils.diffPermalinks oldLinks newLinks
if List.isEmpty toDelete && List.isEmpty toAdd then if List.isEmpty toDelete && List.isEmpty toAdd then
return () return ()
else else
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId) [ cmd.Parameters.AddWithValue ("@postId", postId.Value)
cmd.Parameters.Add ("@link", SqliteType.Text) cmd.Parameters.Add ("@link", SqliteType.Text)
] |> ignore ] |> ignore
let runCmd link = backgroundTask { let runCmd (link: Permalink) = backgroundTask {
cmd.Parameters["@link"].Value <- Permalink.toString link cmd.Parameters["@link"].Value <- link.Value
do! write cmd do! write cmd
} }
cmd.CommandText <- "DELETE FROM post_permalink WHERE post_id = @postId AND permalink = @link" 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 /// 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 let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
if List.isEmpty toDelete && List.isEmpty toAdd then if List.isEmpty toDelete && List.isEmpty toAdd then
return () return ()
@ -168,10 +168,10 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
let runCmd withText rev = backgroundTask { let runCmd withText rev = backgroundTask {
cmd.Parameters.Clear () cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId) [ cmd.Parameters.AddWithValue ("@postId", postId.Value)
cmd.Parameters.AddWithValue ("@asOf", instantParam rev.AsOf) cmd.Parameters.AddWithValue ("@asOf", instantParam rev.AsOf)
] |> ignore ] |> 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 do! write cmd
} }
cmd.CommandText <- "DELETE FROM post_revision WHERE post_id = @postId AND as_of = @asOf" 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 /// 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 () use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT COUNT(id) FROM post WHERE web_log_id = @webLogId AND status = @status" cmd.CommandText <- "SELECT COUNT(id) FROM post WHERE web_log_id = @webLogId AND status = @status"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@status", PostStatus.toString status) |> ignore cmd.Parameters.AddWithValue ("@status", status.Value) |> ignore
return! count cmd 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) /// 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 () use cmd = conn.CreateCommand ()
cmd.CommandText <- $"{selectPost} WHERE p.web_log_id = @webLogId AND p.permalink = @link" cmd.CommandText <- $"{selectPost} WHERE p.web_log_id = @webLogId AND p.permalink = @link"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@link", Permalink.toString permalink) |> ignore cmd.Parameters.AddWithValue ("@link", permalink.Value) |> ignore
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
if rdr.Read () then if rdr.Read () then
let! post = appendPostCategoryAndTag (toPost rdr) let! post = appendPostCategoryAndTag (toPost rdr)
@ -253,7 +253,7 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
match! findFullById postId webLogId with match! findFullById postId webLogId with
| Some _ -> | Some _ ->
use cmd = conn.CreateCommand () use cmd = conn.CreateCommand ()
cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore cmd.Parameters.AddWithValue ("@id", postId.Value) |> ignore
cmd.CommandText <- cmd.CommandText <-
"DELETE FROM post_revision WHERE post_id = @id; "DELETE FROM post_revision WHERE post_id = @id;
DELETE FROM post_permalink 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 /// Find the current permalink from a list of potential prior permalinks for the given web log
let findCurrentPermalink permalinks webLogId = backgroundTask { let findCurrentPermalink permalinks webLogId = backgroundTask {
use cmd = conn.CreateCommand () 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 <- $" cmd.CommandText <- $"
SELECT p.permalink SELECT p.permalink
FROM post p 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) /// Get a page of categorized posts for the given web log (excludes revisions and prior permalinks)
let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = backgroundTask { let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand () 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 <- $" cmd.CommandText <- $"
{selectPost} {selectPost}
INNER JOIN post_category pc ON pc.post_id = p.id 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 ORDER BY published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore cmd.Parameters.AddWithValue ("@status", Published.Value) |> ignore
cmd.Parameters.AddRange catParams cmd.Parameters.AddRange catParams
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
let! posts = let! posts =
@ -348,7 +348,7 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
ORDER BY p.published_on DESC ORDER BY p.published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore cmd.Parameters.AddWithValue ("@status", Published.Value) |> ignore
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
let! posts = let! posts =
toList toPost rdr toList toPost rdr
@ -369,7 +369,7 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
ORDER BY p.published_on DESC ORDER BY p.published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}" LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
addWebLogId cmd webLogId addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) [ cmd.Parameters.AddWithValue ("@status", Published.Value)
cmd.Parameters.AddWithValue ("@tag", tag) cmd.Parameters.AddWithValue ("@tag", tag)
] |> ignore ] |> ignore
use! rdr = cmd.ExecuteReaderAsync () use! rdr = cmd.ExecuteReaderAsync ()
@ -391,7 +391,7 @@ type SQLitePostData (conn : SqliteConnection, ser : JsonSerializer) =
ORDER BY p.published_on DESC ORDER BY p.published_on DESC
LIMIT 1" LIMIT 1"
addWebLogId cmd webLogId addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) [ cmd.Parameters.AddWithValue ("@status", Published.Value)
cmd.Parameters.AddWithValue ("@publishedOn", instantParam publishedOn) cmd.Parameters.AddWithValue ("@publishedOn", instantParam publishedOn)
] |> ignore ] |> ignore
use! rdr = cmd.ExecuteReaderAsync () 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) = let addUploadParameters (cmd : SqliteCommand) (upload : Upload) =
[ cmd.Parameters.AddWithValue ("@id", UploadId.toString upload.Id) [ cmd.Parameters.AddWithValue ("@id", UploadId.toString upload.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString upload.WebLogId) 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 ("@updatedOn", instantParam upload.UpdatedOn)
cmd.Parameters.AddWithValue ("@dataLength", upload.Data.Length) cmd.Parameters.AddWithValue ("@dataLength", upload.Data.Length)
] |> ignore ] |> ignore
@ -53,7 +53,7 @@ type SQLiteUploadData (conn : SqliteConnection) =
do! rdr.CloseAsync () do! rdr.CloseAsync ()
cmd.CommandText <- "DELETE FROM upload WHERE id = @id AND web_log_id = @webLogId" cmd.CommandText <- "DELETE FROM upload WHERE id = @id AND web_log_id = @webLogId"
do! write cmd do! write cmd
return Ok (Permalink.toString upload.Path) return Ok upload.Path.Value
else else
return Error $"""Upload ID {cmd.Parameters["@id"]} not found""" 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 ("@id", CustomFeedId.toString feed.Id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId)
cmd.Parameters.AddWithValue ("@source", CustomFeedSource.toString feed.Source) 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 cmd.Parameters.AddWithValue ("@podcast", maybe (if Option.isSome feed.Podcast then
Some (Utils.serialize ser feed.Podcast) Some (Utils.serialize ser feed.Podcast)
else None)) 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 FundingUrl = Map.tryString "funding_url" podcastRdr
FundingText = Map.tryString "funding_text" podcastRdr FundingText = Map.tryString "funding_text" podcastRdr
Medium = Map.tryString "medium" podcastRdr Medium = Map.tryString "medium" podcastRdr
|> Option.map PodcastMedium.parse |> Option.map PodcastMedium.Parse
} }
} |> List.ofSeq } |> List.ofSeq
podcastRdr.Close () podcastRdr.Close ()
@ -241,7 +241,7 @@ type SQLiteData (conn : SqliteConnection, log : ILogger<SQLiteData>, ser : JsonS
|> List.iter (fun (postId, episode) -> |> List.iter (fun (postId, episode) ->
cmd.CommandText <- "UPDATE post SET episode = @episode WHERE id = @id" cmd.CommandText <- "UPDATE post SET episode = @episode WHERE id = @id"
[ cmd.Parameters.AddWithValue ("@episode", Utils.serialize ser episode) [ 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 () let _ = cmd.ExecuteNonQuery ()
cmd.Parameters.Clear ()) 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 /// Find the permalinks added and removed
let diffPermalinks oldLinks newLinks = let diffPermalinks oldLinks newLinks =
diffLists oldLinks newLinks Permalink.toString diffLists oldLinks newLinks (fun (it: Permalink) -> it.Value)
/// Find the revisions added and removed /// Find the revisions added and removed
let diffRevisions oldRevs newRevs = 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 MyWebLog.Converters
open Newtonsoft.Json open Newtonsoft.Json

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

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

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

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

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

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

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

@ -37,13 +37,12 @@ let deriveFeedType (ctx : HttpContext) feedPath : (FeedType * int) option =
| false -> | false ->
// Category and tag feeds are handled by defined routes; check for custom feed // Category and tag feeds are handled by defined routes; check for custom feed
match webLog.Rss.CustomFeeds 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 -> | Some feed ->
debug (fun () -> "Found custom feed") debug (fun () -> "Found custom feed")
Some (Custom (feed, feedPath), Some (Custom (feed, feedPath), feed.Podcast |> Option.map _.ItemsInFeed |> Option.defaultValue postCount)
feed.Podcast |> Option.map (fun p -> p.ItemsInFeed) |> Option.defaultValue postCount)
| None -> | None ->
debug (fun () -> $"No matching feed found") debug (fun () -> "No matching feed found")
None None
/// Determine the function to retrieve posts for the given feed /// 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 when Option.isSome podcast.MediaBaseUrl -> $"{podcast.MediaBaseUrl.Value}{link}"
| link -> WebLog.absoluteUrl webLog (Permalink link) | link -> WebLog.absoluteUrl webLog (Permalink link)
let epMediaType = [ episode.MediaType; podcast.DefaultMediaType ] |> List.tryFind Option.isSome |> Option.flatten 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 epExplicit = (defaultArg episode.Explicit podcast.Explicit).Value
let xmlDoc = XmlDocument() let xmlDoc = XmlDocument()
@ -310,8 +309,7 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
podcast.PodcastGuid podcast.PodcastGuid
|> Option.iter (fun guid -> |> Option.iter (fun guid ->
rssFeed.ElementExtensions.Add("guid", Namespace.podcast, guid.ToString().ToLowerInvariant())) rssFeed.ElementExtensions.Add("guid", Namespace.podcast, guid.ToString().ToLowerInvariant()))
podcast.Medium podcast.Medium |> Option.iter (fun med -> rssFeed.ElementExtensions.Add("medium", Namespace.podcast, med.Value))
|> Option.iter (fun med -> rssFeed.ElementExtensions.Add("medium", Namespace.podcast, PodcastMedium.toString med))
/// Get the feed's self reference and non-feed link /// Get the feed's self reference and non-feed link
let private selfAndLink webLog feedType ctx = 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 match podcast, post.Episode with
| Some feed, Some episode -> addEpisode webLog (Option.get feed.Podcast) episode post item | Some feed, Some episode -> addEpisode webLog (Option.get feed.Podcast) episode post item
| Some _, _ -> | 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
| _ -> item | _ -> item
@ -438,13 +436,13 @@ let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next
|> addToHash ViewContext.Model (EditCustomFeedModel.fromFeed f) |> addToHash ViewContext.Model (EditCustomFeedModel.fromFeed f)
|> addToHash "medium_values" [| |> addToHash "medium_values" [|
KeyValuePair.Create("", "&ndash; Unspecified &ndash;") KeyValuePair.Create("", "&ndash; Unspecified &ndash;")
KeyValuePair.Create (PodcastMedium.toString Podcast, "Podcast") KeyValuePair.Create(Podcast.Value, "Podcast")
KeyValuePair.Create (PodcastMedium.toString Music, "Music") KeyValuePair.Create(Music.Value, "Music")
KeyValuePair.Create (PodcastMedium.toString Video, "Video") KeyValuePair.Create(Video.Value, "Video")
KeyValuePair.Create (PodcastMedium.toString Film, "Film") KeyValuePair.Create(Film.Value, "Film")
KeyValuePair.Create (PodcastMedium.toString Audiobook, "Audiobook") KeyValuePair.Create(Audiobook.Value, "Audiobook")
KeyValuePair.Create (PodcastMedium.toString Newsletter, "Newsletter") KeyValuePair.Create(Newsletter.Value, "Newsletter")
KeyValuePair.Create (PodcastMedium.toString Blog, "Blog") KeyValuePair.Create(Blog.Value, "Blog")
|] |]
|> adminView "custom-feed-edit" next ctx |> adminView "custom-feed-edit" next ctx
| None -> Error.notFound 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! {| return! {|
content = content =
[ """<div class="mwl-revision-preview mb-3">""" [ """<div class="mwl-revision-preview mb-3">"""
(MarkupText.toHtml >> addBaseToRelativeUrls extra) rev.Text rev.Text.AsHtml() |> addBaseToRelativeUrls extra
"</div>" "</div>"
] ]
|> String.concat "" |> String.concat ""
@ -180,7 +180,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let tryPage = let tryPage =
if model.IsNew then if model.IsNew then
{ Page.empty with { Page.empty with
Id = PageId.create () Id = PageId.Create()
WebLogId = ctx.WebLog.Id WebLogId = ctx.WebLog.Id
AuthorId = ctx.UserId AuthorId = ctx.UserId
PublishedOn = now 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 do! (if model.IsNew then data.Page.Add else data.Page.Update) updatedPage
if updateList then do! PageListCache.update ctx if updateList then do! PageListCache.update ctx
do! addMessage ctx { UserMessage.success with Message = "Page saved successfully" } 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 | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound 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) | _ -> Task.FromResult (None, None)
let newerLink = let newerLink =
match listType, pageNbr with match listType, pageNbr with
| SinglePost, _ -> newerPost |> Option.map (fun p -> Permalink.toString p.Permalink) | SinglePost, _ -> newerPost |> Option.map _.Permalink.Value
| _, 1 -> None | _, 1 -> None
| PostList, 2 when webLog.DefaultPage = "posts" -> Some "" | PostList, 2 when webLog.DefaultPage = "posts" -> Some ""
| PostList, _ -> relUrl $"page/{pageNbr - 1}" | 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}" | AdminList, _ -> relUrl $"admin/posts/page/{pageNbr - 1}"
let olderLink = let olderLink =
match listType, List.length posts > perPage with 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 | _, false -> None
| PostList, true -> relUrl $"page/{pageNbr + 1}" | PostList, true -> relUrl $"page/{pageNbr + 1}"
| CategoryList, true -> relUrl $"category/{url}/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 Authors = authors
Subtitle = None Subtitle = None
NewerLink = newerLink NewerLink = newerLink
NewerName = newerPost |> Option.map (fun p -> p.Title) NewerName = newerPost |> Option.map _.Title
OlderLink = olderLink OlderLink = olderLink
OlderName = olderPost |> Option.map (fun p -> p.Title) OlderName = olderPost |> Option.map _.Title
} }
return return
makeHash {||} makeHash {||}
@ -333,7 +333,7 @@ let previewRevision (postId, revDate) : HttpHandler = requireAccess Author >=> f
return! {| return! {|
content = content =
[ """<div class="mwl-revision-preview mb-3">""" [ """<div class="mwl-revision-preview mb-3">"""
(MarkupText.toHtml >> addBaseToRelativeUrls extra) rev.Text rev.Text.AsHtml() |> addBaseToRelativeUrls extra
"</div>" "</div>"
] ]
|> String.concat "" |> String.concat ""
@ -379,7 +379,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let tryPost = let tryPost =
if model.IsNew then if model.IsNew then
{ Post.empty with { Post.empty with
Id = PostId.create () Id = PostId.Create()
WebLogId = ctx.WebLog.Id WebLogId = ctx.WebLog.Id
AuthorId = ctx.UserId AuthorId = ctx.UserId
} |> someTask } |> someTask
@ -410,7 +410,7 @@ let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|> List.length = List.length priorCats) then |> List.length = List.length priorCats) then
do! CategoryCache.update ctx do! CategoryCache.update ctx
do! addMessage ctx { UserMessage.success with Message = "Post saved successfully" } 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 | Some _ -> return! Error.notAuthorized next ctx
| None -> return! Error.notFound next ctx | None -> return! Error.notFound next ctx
} }

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

@ -23,8 +23,8 @@ module CatchAll =
seq { seq {
debug (fun () -> $"Considering URL {textLink}") debug (fun () -> $"Considering URL {textLink}")
// Home page directory without the directory slash // Home page directory without the directory slash
if textLink = "" then yield redirectTo true (WebLog.relativeUrl webLog Permalink.empty) if textLink = "" then yield redirectTo true (WebLog.relativeUrl webLog Permalink.Empty)
let permalink = Permalink (textLink.Substring 1) let permalink = Permalink textLink[1..]
// Current post // Current post
match data.Post.FindByPermalink permalink webLog.Id |> await with match data.Post.FindByPermalink permalink webLog.Id |> await with
| Some post -> | 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 // Create the web log
let webLogId = WebLogId.create () let webLogId = WebLogId.create ()
let userId = WebLogUserId.create () let userId = WebLogUserId.create ()
let homePageId = PageId.create () let homePageId = PageId.Create()
let slug = Handlers.Upload.makeSlug args[2] 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 // 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] Name = args[2]
Slug = slug Slug = slug
UrlBase = args[1] UrlBase = args[1]
DefaultPage = PageId.toString homePageId DefaultPage = homePageId.Value
TimeZone = timeZone TimeZone = timeZone
} }
@ -110,8 +110,8 @@ let private importPriorPermalinks urlBase file (sp : IServiceProvider) = task {
let! withLinks = data.Post.FindFullById post.Id post.WebLogId let! withLinks = data.Post.FindFullById post.Id post.WebLogId
let! _ = data.Post.UpdatePriorPermalinks post.Id post.WebLogId let! _ = data.Post.UpdatePriorPermalinks post.Id post.WebLogId
(old :: withLinks.Value.PriorPermalinks) (old :: withLinks.Value.PriorPermalinks)
printfn $"{Permalink.toString old} -> {Permalink.toString current}" printfn $"{old.Value} -> {current.Value}"
| None -> eprintfn $"Cannot find current post for {Permalink.toString current}" | None -> eprintfn $"Cannot find current post for {current.Value}"
printfn "Done!" printfn "Done!"
| None -> eprintfn $"No web log found at {urlBase}" | None -> eprintfn $"No web log found at {urlBase}"
} }
@ -336,8 +336,8 @@ module Backup =
let newWebLogId = WebLogId.create () let newWebLogId = WebLogId.create ()
let newCatIds = archive.Categories |> List.map (fun cat -> cat.Id, CategoryId.Create ()) |> dict 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 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 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 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 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 let newUpIds = archive.Uploads |> List.map (fun up -> up.Id, UploadId.create ()) |> dict
return return