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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

@ -89,14 +89,14 @@ type DisplayCustomFeed = {
module DisplayCustomFeed =
/// Create a display version from a custom feed
let fromFeed (cats : DisplayCategory[]) (feed : CustomFeed) : DisplayCustomFeed =
let fromFeed (cats: DisplayCategory[]) (feed: CustomFeed) : DisplayCustomFeed =
let source =
match feed.Source with
| Category (CategoryId catId) -> $"Category: {(cats |> Array.find (fun cat -> cat.Id = catId)).Name}"
| Tag tag -> $"Tag: {tag}"
{ Id = CustomFeedId.toString feed.Id
Source = source
Path = Permalink.toString feed.Path
Path = feed.Path.Value
IsPodcast = Option.isSome feed.Podcast
}
@ -136,16 +136,15 @@ type DisplayPage =
}
/// Create a minimal display page (no text or metadata) from a database page
static member FromPageMinimal webLog (page : Page) =
let pageId = PageId.toString page.Id
{ Id = pageId
static member FromPageMinimal webLog (page: Page) = {
Id = page.Id.Value
AuthorId = WebLogUserId.toString page.AuthorId
Title = page.Title
Permalink = Permalink.toString page.Permalink
Permalink = page.Permalink.Value
PublishedOn = WebLog.localTime webLog page.PublishedOn
UpdatedOn = WebLog.localTime webLog page.UpdatedOn
IsInPageList = page.IsInPageList
IsDefault = pageId = webLog.DefaultPage
IsDefault = page.Id.Value = webLog.DefaultPage
Text = ""
Metadata = []
}
@ -153,15 +152,14 @@ type DisplayPage =
/// Create a display page from a database page
static member FromPage webLog (page : Page) =
let _, extra = WebLog.hostAndPath webLog
let pageId = PageId.toString page.Id
{ Id = pageId
{ Id = page.Id.Value
AuthorId = WebLogUserId.toString page.AuthorId
Title = page.Title
Permalink = Permalink.toString page.Permalink
Permalink = page.Permalink.Value
PublishedOn = WebLog.localTime webLog page.PublishedOn
UpdatedOn = WebLog.localTime webLog page.UpdatedOn
IsInPageList = page.IsInPageList
IsDefault = pageId = webLog.DefaultPage
IsDefault = page.Id.Value = webLog.DefaultPage
Text = addBaseToRelativeUrls extra page.Text
Metadata = page.Metadata
}
@ -187,7 +185,7 @@ module DisplayRevision =
let fromRevision webLog (rev : Revision) =
{ AsOf = rev.AsOf.ToDateTimeUtc ()
AsOfLocal = WebLog.localTime webLog rev.AsOf
Format = MarkupText.sourceType rev.Text
Format = rev.Text.SourceType
}
@ -253,7 +251,7 @@ module DisplayUpload =
/// Create a display uploaded file
let fromUpload webLog source (upload : Upload) =
let path = Permalink.toString upload.Path
let path = upload.Path.Value
let name = Path.GetFileName path
{ Id = UploadId.toString upload.Id
Name = name
@ -436,13 +434,13 @@ type EditCustomFeedModel =
}
/// Create a model from a custom feed
static member fromFeed (feed : CustomFeed) =
static member fromFeed (feed: CustomFeed) =
let rss =
{ EditCustomFeedModel.empty with
Id = CustomFeedId.toString feed.Id
SourceType = match feed.Source with Category _ -> "category" | Tag _ -> "tag"
SourceValue = match feed.Source with Category (CategoryId catId) -> catId | Tag tag -> tag
Path = Permalink.toString feed.Path
Path = feed.Path.Value
}
match feed.Podcast with
| Some p ->
@ -454,7 +452,7 @@ type EditCustomFeedModel =
Summary = p.Summary
DisplayedAuthor = p.DisplayedAuthor
Email = p.Email
ImageUrl = Permalink.toString p.ImageUrl
ImageUrl = p.ImageUrl.Value
AppleCategory = p.AppleCategory
AppleSubcategory = defaultArg p.AppleSubcategory ""
Explicit = p.Explicit.Value
@ -462,10 +460,8 @@ type EditCustomFeedModel =
MediaBaseUrl = defaultArg p.MediaBaseUrl ""
FundingUrl = defaultArg p.FundingUrl ""
FundingText = defaultArg p.FundingText ""
PodcastGuid = p.PodcastGuid
|> Option.map (fun it -> it.ToString().ToLowerInvariant ())
|> Option.defaultValue ""
Medium = p.Medium |> Option.map PodcastMedium.toString |> Option.defaultValue ""
PodcastGuid = p.PodcastGuid |> Option.map _.ToString().ToLowerInvariant() |> Option.defaultValue ""
Medium = p.Medium |> Option.map _.Value |> Option.defaultValue ""
}
| None -> rss
@ -492,7 +488,7 @@ type EditCustomFeedModel =
PodcastGuid = noneIfBlank this.PodcastGuid |> Option.map Guid.Parse
FundingUrl = noneIfBlank this.FundingUrl
FundingText = noneIfBlank this.FundingText
Medium = noneIfBlank this.Medium |> Option.map PodcastMedium.parse
Medium = noneIfBlank this.Medium |> Option.map PodcastMedium.Parse
}
else
None
@ -530,61 +526,61 @@ type EditMyInfoModel =
/// View model to edit a page
[<CLIMutable; NoComparison; NoEquality>]
type EditPageModel =
{ /// The ID of the page being edited
PageId : string
type EditPageModel = {
/// The ID of the page being edited
PageId: string
/// The title of the page
Title : string
Title: string
/// The permalink for the page
Permalink : string
Permalink: string
/// The template to use to display the page
Template : string
Template: string
/// Whether this page is shown in the page list
IsShownInPageList : bool
IsShownInPageList: bool
/// The source format for the text
Source : string
Source: string
/// The text of the page
Text : string
Text: string
/// Names of metadata items
MetaNames : string[]
MetaNames: string array
/// Values of metadata items
MetaValues : string[]
}
MetaValues: string array
} with
/// Create an edit model from an existing page
static member fromPage (page : Page) =
static member fromPage (page: Page) =
let latest =
match page.Revisions |> List.sortByDescending (fun r -> r.AsOf) |> List.tryHead with
match page.Revisions |> List.sortByDescending _.AsOf |> List.tryHead with
| Some rev -> rev
| None -> Revision.empty
let page = if page.Metadata |> List.isEmpty then { page with Metadata = [ MetaItem.empty ] } else page
{ PageId = PageId.toString page.Id
| None -> Revision.Empty
let page = if page.Metadata |> List.isEmpty then { page with Metadata = [ MetaItem.Empty ] } else page
{ PageId = page.Id.Value
Title = page.Title
Permalink = Permalink.toString page.Permalink
Permalink = page.Permalink.Value
Template = defaultArg page.Template ""
IsShownInPageList = page.IsInPageList
Source = MarkupText.sourceType latest.Text
Text = MarkupText.text latest.Text
MetaNames = page.Metadata |> List.map (fun m -> m.Name) |> Array.ofList
MetaValues = page.Metadata |> List.map (fun m -> m.Value) |> Array.ofList
Source = latest.Text.SourceType
Text = latest.Text.Text
MetaNames = page.Metadata |> List.map _.Name |> Array.ofList
MetaValues = page.Metadata |> List.map _.Value |> Array.ofList
}
/// Whether this is a new page
member this.IsNew = this.PageId = "new"
/// Update a page with values from this model
member this.UpdatePage (page : Page) now =
let revision = { AsOf = now; Text = MarkupText.parse $"{this.Source}: {this.Text}" }
member this.UpdatePage (page: Page) now =
let revision = { AsOf = now; Text = MarkupText.Parse $"{this.Source}: {this.Text}" }
// Detect a permalink change, and add the prior one to the prior list
match Permalink.toString page.Permalink with
match page.Permalink.Value with
| "" -> page
| link when link = this.Permalink -> page
| _ -> { page with PriorPermalinks = page.Permalink :: page.PriorPermalinks }
@ -596,7 +592,7 @@ type EditPageModel =
UpdatedOn = now
IsInPageList = this.IsShownInPageList
Template = match this.Template with "" -> None | tmpl -> Some tmpl
Text = MarkupText.toHtml revision.Text
Text = revision.Text.AsHtml()
Metadata = Seq.zip this.MetaNames this.MetaValues
|> Seq.filter (fun it -> fst it > "")
|> Seq.map (fun it -> { Name = fst it; Value = snd it })
@ -610,127 +606,127 @@ type EditPageModel =
/// View model to edit a post
[<CLIMutable; NoComparison; NoEquality>]
type EditPostModel =
{ /// The ID of the post being edited
PostId : string
type EditPostModel = {
/// The ID of the post being edited
PostId: string
/// The title of the post
Title : string
Title: string
/// The permalink for the post
Permalink : string
Permalink: string
/// The source format for the text
Source : string
Source: string
/// The text of the post
Text : string
Text: string
/// The tags for the post
Tags : string
Tags: string
/// The template used to display the post
Template : string
Template: string
/// The category IDs for the post
CategoryIds : string[]
CategoryIds: string array
/// The post status
Status : string
Status: string
/// Whether this post should be published
DoPublish : bool
DoPublish: bool
/// Names of metadata items
MetaNames : string[]
MetaNames: string array
/// Values of metadata items
MetaValues : string[]
MetaValues: string array
/// Whether to override the published date/time
SetPublished : bool
SetPublished: bool
/// The published date/time to override
PubOverride : Nullable<DateTime>
PubOverride: Nullable<DateTime>
/// Whether all revisions should be purged and the override date set as the updated date as well
SetUpdated : bool
SetUpdated: bool
/// Whether this post has a podcast episode
IsEpisode : bool
IsEpisode: bool
/// The URL for the media for this episode (may be permalink)
Media : string
Media: string
/// The size (in bytes) of the media for this episode
Length : int64
Length: int64
/// The duration of the media for this episode
Duration : string
Duration: string
/// The media type (optional, defaults to podcast-defined media type)
MediaType : string
MediaType: string
/// The URL for the image for this episode (may be permalink; optional, defaults to podcast image)
ImageUrl : string
ImageUrl: string
/// A subtitle for the episode (optional)
Subtitle : string
Subtitle: string
/// The explicit rating for this episode (optional, defaults to podcast setting)
Explicit : string
Explicit: string
/// The URL for the chapter file for the episode (may be permalink; optional)
ChapterFile : string
ChapterFile: string
/// The type of the chapter file (optional; defaults to application/json+chapters if chapterFile is provided)
ChapterType : string
ChapterType: string
/// The URL for the transcript (may be permalink; optional)
TranscriptUrl : string
TranscriptUrl: string
/// The MIME type for the transcript (optional, recommended if transcriptUrl is provided)
TranscriptType : string
TranscriptType: string
/// The language of the transcript (optional)
TranscriptLang : string
TranscriptLang: string
/// Whether the provided transcript should be presented as captions
TranscriptCaptions : bool
TranscriptCaptions: bool
/// The season number (optional)
SeasonNumber : int
SeasonNumber: int
/// A description of this season (optional, ignored if season number is not provided)
SeasonDescription : string
SeasonDescription: string
/// The episode number (decimal; optional)
EpisodeNumber : string
EpisodeNumber: string
/// 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
static member fromPost webLog (post : Post) =
static member fromPost webLog (post: Post) =
let latest =
match post.Revisions |> List.sortByDescending (_.AsOf) |> List.tryHead with
match post.Revisions |> List.sortByDescending _.AsOf |> List.tryHead with
| Some rev -> rev
| None -> Revision.empty
let post = if post.Metadata |> List.isEmpty then { post with Metadata = [ MetaItem.empty ] } else post
| None -> Revision.Empty
let post = if post.Metadata |> List.isEmpty then { post with Metadata = [ MetaItem.Empty ] } else post
let episode = defaultArg post.Episode Episode.Empty
{ PostId = PostId.toString post.Id
{ PostId = post.Id.Value
Title = post.Title
Permalink = Permalink.toString post.Permalink
Source = MarkupText.sourceType latest.Text
Text = MarkupText.text latest.Text
Permalink = post.Permalink.Value
Source = latest.Text.SourceType
Text = latest.Text.Text
Tags = String.Join (", ", post.Tags)
Template = defaultArg post.Template ""
CategoryIds = post.CategoryIds |> List.map (_.Value) |> Array.ofList
Status = PostStatus.toString post.Status
CategoryIds = post.CategoryIds |> List.map _.Value |> Array.ofList
Status = post.Status.Value
DoPublish = false
MetaNames = post.Metadata |> List.map (_.Name) |> Array.ofList
MetaValues = post.Metadata |> List.map (_.Value) |> Array.ofList
MetaNames = post.Metadata |> List.map _.Name |> Array.ofList
MetaValues = post.Metadata |> List.map _.Value |> Array.ofList
SetPublished = false
PubOverride = post.PublishedOn |> Option.map (WebLog.localTime webLog) |> Option.toNullable
SetUpdated = false
@ -741,7 +737,7 @@ type EditPostModel =
MediaType = defaultArg episode.MediaType ""
ImageUrl = defaultArg episode.ImageUrl ""
Subtitle = defaultArg episode.Subtitle ""
Explicit = defaultArg (episode.Explicit |> Option.map (_.Value)) ""
Explicit = defaultArg (episode.Explicit |> Option.map _.Value) ""
ChapterFile = defaultArg episode.ChapterFile ""
ChapterType = defaultArg episode.ChapterType ""
TranscriptUrl = defaultArg episode.TranscriptUrl ""
@ -758,10 +754,10 @@ type EditPostModel =
member this.IsNew = this.PostId = "new"
/// Update a post with values from the submitted form
member this.UpdatePost (post : Post) now =
let revision = { AsOf = now; Text = MarkupText.parse $"{this.Source}: {this.Text}" }
member this.UpdatePost (post: Post) now =
let revision = { AsOf = now; Text = MarkupText.Parse $"{this.Source}: {this.Text}" }
// Detect a permalink change, and add the prior one to the prior list
match Permalink.toString post.Permalink with
match post.Permalink.Value with
| "" -> post
| link when link = this.Permalink -> post
| _ -> { post with PriorPermalinks = post.Permalink :: post.PriorPermalinks }
@ -772,7 +768,7 @@ type EditPostModel =
Permalink = Permalink this.Permalink
PublishedOn = if this.DoPublish then Some now else post.PublishedOn
UpdatedOn = now
Text = MarkupText.toHtml revision.Text
Text = revision.Text.AsHtml()
Tags = this.Tags.Split ","
|> Seq.ofArray
|> Seq.map (fun it -> it.Trim().ToLower ())
@ -1005,39 +1001,39 @@ type LogOnModel =
/// View model to manage permalinks
[<CLIMutable; NoComparison; NoEquality>]
type ManagePermalinksModel =
{ /// The ID for the entity being edited
Id : string
type ManagePermalinksModel = {
/// The ID for the entity being edited
Id: string
/// The type of entity being edited ("page" or "post")
Entity : string
Entity: string
/// The current title of the page or post
CurrentTitle : string
CurrentTitle: string
/// The current permalink of the page or post
CurrentPermalink : string
CurrentPermalink: string
/// The prior permalinks for the page or post
Prior : string[]
}
Prior: string array
} with
/// Create a permalink model from a page
static member fromPage (pg : Page) =
{ Id = PageId.toString pg.Id
static member fromPage (pg: Page) =
{ Id = pg.Id.Value
Entity = "page"
CurrentTitle = pg.Title
CurrentPermalink = Permalink.toString pg.Permalink
Prior = pg.PriorPermalinks |> List.map Permalink.toString |> Array.ofList
CurrentPermalink = pg.Permalink.Value
Prior = pg.PriorPermalinks |> List.map _.Value |> Array.ofList
}
/// Create a permalink model from a post
static member fromPost (post : Post) =
{ Id = PostId.toString post.Id
static member fromPost (post: Post) =
{ Id = post.Id.Value
Entity = "post"
CurrentTitle = post.Title
CurrentPermalink = Permalink.toString post.Permalink
Prior = post.PriorPermalinks |> List.map Permalink.toString |> Array.ofList
CurrentPermalink = post.Permalink.Value
Prior = post.PriorPermalinks |> List.map _.Value |> Array.ofList
}
@ -1054,20 +1050,20 @@ type ManageRevisionsModel =
CurrentTitle : string
/// The revisions for the page or post
Revisions : DisplayRevision[]
Revisions : DisplayRevision array
}
/// Create a revision model from a page
static member fromPage webLog (pg : Page) =
{ Id = PageId.toString pg.Id
static member fromPage webLog (pg: Page) =
{ Id = pg.Id.Value
Entity = "page"
CurrentTitle = pg.Title
Revisions = pg.Revisions |> List.map (DisplayRevision.fromRevision webLog) |> Array.ofList
}
/// Create a revision model from a post
static member fromPost webLog (post : Post) =
{ Id = PostId.toString post.Id
static member fromPost webLog (post: Post) =
{ Id = post.Id.Value
Entity = "post"
CurrentTitle = post.Title
Revisions = post.Revisions |> List.map (DisplayRevision.fromRevision webLog) |> Array.ofList
@ -1076,53 +1072,53 @@ type ManageRevisionsModel =
/// View model for posts in a list
[<NoComparison; NoEquality>]
type PostListItem =
{ /// The ID of the post
Id : string
type PostListItem = {
/// The ID of the post
Id: string
/// The ID of the user who authored the post
AuthorId : string
AuthorId: string
/// The status of the post
Status : string
Status: string
/// The title of the post
Title : string
Title: string
/// The permalink for the post
Permalink : string
Permalink: string
/// When this post was published
PublishedOn : Nullable<DateTime>
PublishedOn: Nullable<DateTime>
/// When this post was last updated
UpdatedOn : DateTime
UpdatedOn: DateTime
/// The text of the post
Text : string
Text: string
/// The IDs of the categories for this post
CategoryIds : string list
CategoryIds: string list
/// Tags for the post
Tags : string list
Tags: string list
/// The podcast episode information for this post
Episode : Episode option
Episode: Episode option
/// Metadata for the post
Metadata : MetaItem list
}
Metadata: MetaItem list
} with
/// 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 inTZ = WebLog.localTime webLog
{ Id = PostId.toString post.Id
{ Id = post.Id.Value
AuthorId = WebLogUserId.toString post.AuthorId
Status = PostStatus.toString post.Status
Status = post.Status.Value
Title = post.Title
Permalink = Permalink.toString post.Permalink
Permalink = post.Permalink.Value
PublishedOn = post.PublishedOn |> Option.map inTZ |> Option.toNullable
UpdatedOn = inTZ post.UpdatedOn
Text = addBaseToRelativeUrls extra post.Text

18
src/MyWebLog/DotLiquidBespoke.fs
View File

@ -101,10 +101,10 @@ type ThemeAssetFilter () =
/// Create various items in the page header based on the state of the page being generated
type PageHeadTag () =
inherit Tag ()
type PageHeadTag() =
inherit Tag()
override this.Render (context : Context, result : TextWriter) =
override this.Render(context: Context, result: TextWriter) =
let webLog = context.WebLog
// spacer
let s = " "
@ -115,9 +115,9 @@ type PageHeadTag () =
// Theme assets
if assetExists "style.css" webLog then
result.WriteLine $"""{s}<link rel="stylesheet" href="{ThemeAssetFilter.ThemeAsset (context, "style.css")}">"""
result.WriteLine $"""{s}<link rel="stylesheet" href="{ThemeAssetFilter.ThemeAsset(context, "style.css")}">"""
if assetExists "favicon.ico" webLog then
result.WriteLine $"""{s}<link rel="icon" href="{ThemeAssetFilter.ThemeAsset (context, "favicon.ico")}">"""
result.WriteLine $"""{s}<link rel="icon" href="{ThemeAssetFilter.ThemeAsset(context, "favicon.ico")}">"""
// RSS feeds and canonical URLs
let feedLink title url =
@ -126,16 +126,16 @@ type PageHeadTag () =
$"""{s}<link rel="alternate" type="application/rss+xml" title="{escTitle}" href="{relUrl}">"""
if webLog.Rss.IsFeedEnabled && getBool "is_home" then
result.WriteLine (feedLink webLog.Name webLog.Rss.FeedName)
result.WriteLine $"""{s}<link rel="canonical" href="{WebLog.absoluteUrl webLog Permalink.empty}">"""
result.WriteLine(feedLink webLog.Name webLog.Rss.FeedName)
result.WriteLine $"""{s}<link rel="canonical" href="{WebLog.absoluteUrl webLog Permalink.Empty}">"""
if webLog.Rss.IsCategoryEnabled && getBool "is_category_home" then
let slug = context.Environments[0].["slug"] :?> string
result.WriteLine (feedLink webLog.Name $"category/{slug}/{webLog.Rss.FeedName}")
result.WriteLine(feedLink webLog.Name $"category/{slug}/{webLog.Rss.FeedName}")
if webLog.Rss.IsTagEnabled && getBool "is_tag_home" then
let slug = context.Environments[0].["slug"] :?> string
result.WriteLine (feedLink webLog.Name $"tag/{slug}/{webLog.Rss.FeedName}")
result.WriteLine(feedLink webLog.Name $"tag/{slug}/{webLog.Rss.FeedName}")
if getBool "is_post" then
let post = context.Environments[0].["model"] :?> PostDisplay

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

@ -233,7 +233,7 @@ module RedirectRules =
if idx = -1 then
return!
hashForPage "Add Redirect Rule"
|> addToHash "model" (EditRedirectRuleModel.fromRule -1 RedirectRule.empty)
|> addToHash "model" (EditRedirectRuleModel.fromRule -1 RedirectRule.Empty)
|> withAntiCsrf ctx
|> adminBareView "redirect-edit" next ctx
else
@ -260,7 +260,7 @@ module RedirectRules =
let! model = ctx.BindFormAsync<EditRedirectRuleModel> ()
let isNew = idx = -1
let rules = ctx.WebLog.RedirectRules
let rule = model.UpdateRule (if isNew then RedirectRule.empty else List.item idx rules)
let rule = model.UpdateRule (if isNew then RedirectRule.Empty else List.item idx rules)
let newRules =
match isNew with
| true when model.InsertAtTop -> List.insertAt 0 rule rules
@ -545,7 +545,7 @@ module WebLog =
match! TemplateCache.get adminTheme "tag-mapping-list-body" ctx.Data with
| Ok tagMapTemplate ->
let! allPages = data.Page.All ctx.WebLog.Id
let! themes = data.Theme.All ()
let! themes = data.Theme.All()
let! users = data.WebLogUser.FindByWebLog ctx.WebLog.Id
let! hash =
hashForPage "Web Log Settings"
@ -553,10 +553,10 @@ module WebLog =
|> addToHash ViewContext.Model (SettingsModel.fromWebLog ctx.WebLog)
|> addToHash "pages" (
seq {
KeyValuePair.Create ("posts", "- First Page of Posts -")
KeyValuePair.Create("posts", "- First Page of Posts -")
yield! allPages
|> List.sortBy (fun p -> p.Title.ToLower ())
|> List.map (fun p -> KeyValuePair.Create (PageId.toString p.Id, p.Title))
|> List.sortBy _.Title.ToLower()
|> List.map (fun p -> KeyValuePair.Create(p.Id.Value, p.Title))
}
|> Array.ofSeq)
|> addToHash "themes" (

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

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

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

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

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

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

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

@ -11,20 +11,20 @@ module CatchAll =
open MyWebLog.ViewModels
/// Sequence where the first returned value is the proper handler for the link
let private deriveAction (ctx : HttpContext) : HttpHandler seq =
let private deriveAction (ctx: HttpContext): HttpHandler seq =
let webLog = ctx.WebLog
let data = ctx.Data
let debug = debug "Routes.CatchAll" ctx
let textLink =
let _, extra = WebLog.hostAndPath webLog
let url = string ctx.Request.Path
(if extra = "" then url else url.Substring extra.Length).ToLowerInvariant ()
(if extra = "" then url else url.Substring extra.Length).ToLowerInvariant()
let await it = (Async.AwaitTask >> Async.RunSynchronously) it
seq {
debug (fun () -> $"Considering URL {textLink}")
// Home page directory without the directory slash
if textLink = "" then yield redirectTo true (WebLog.relativeUrl webLog Permalink.empty)
let permalink = Permalink (textLink.Substring 1)
if textLink = "" then yield redirectTo true (WebLog.relativeUrl webLog Permalink.Empty)
let permalink = Permalink textLink[1..]
// Current post
match data.Post.FindByPermalink permalink webLog.Id |> await with
| Some post ->
@ -80,7 +80,7 @@ module CatchAll =
}
// GET {all-of-the-above}
let route : HttpHandler = fun next ctx ->
let route: HttpHandler = fun next ctx ->
match deriveAction ctx |> Seq.tryHead with Some handler -> handler next ctx | None -> Error.notFound next ctx

14
src/MyWebLog/Maintenance.fs
View File

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