v2 RC2 #33
@ -36,6 +36,9 @@
|
||||
<Compile Include="PostgreSql\PostgreSqlPageData.fs" />
|
||||
<Compile Include="PostgreSql\PostgreSqlPostData.fs" />
|
||||
<Compile Include="PostgreSql\PostgreSqlTagMapData.fs" />
|
||||
<Compile Include="PostgreSql\PostgreSqlThemeData.fs" />
|
||||
<Compile Include="PostgreSql\PostgreSqlUploadData.fs" />
|
||||
<Compile Include="PostgreSql\PostgreSqlWebLogData.fs" />
|
||||
<Compile Include="PostgreSqlData.fs" />
|
||||
</ItemGroup>
|
||||
|
||||
|
||||
@ -117,35 +117,47 @@ type PostgreSqlCategoryData (conn : NpgsqlConnection) =
|
||||
| None -> return CategoryNotFound
|
||||
}
|
||||
|
||||
/// Update a category
|
||||
let save (cat : Category) = backgroundTask {
|
||||
/// The INSERT statement for a category
|
||||
let catInsert = """
|
||||
INSERT INTO category (
|
||||
id, web_log_id, name, slug, description, parent_id
|
||||
) VALUES (
|
||||
@id, @webLogId, @name, @slug, @description, @parentId
|
||||
)"""
|
||||
|
||||
/// Create parameters for a category insert / update
|
||||
let catParameters (cat : Category) = [
|
||||
webLogIdParam cat.WebLogId
|
||||
"@id", Sql.string (CategoryId.toString cat.Id)
|
||||
"@name", Sql.string cat.Name
|
||||
"@slug", Sql.string cat.Slug
|
||||
"@description", Sql.stringOrNone cat.Description
|
||||
"@parentId", Sql.stringOrNone (cat.ParentId |> Option.map CategoryId.toString)
|
||||
]
|
||||
|
||||
/// Save a category
|
||||
let save cat = backgroundTask {
|
||||
let! _ =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.query """
|
||||
INSERT INTO category (
|
||||
id, web_log_id, name, slug, description, parent_id
|
||||
) VALUES (
|
||||
@id, @webLogId, @name, @slug, @description, @parentId
|
||||
) ON CONFLICT (id) DO UPDATE
|
||||
|> Sql.query $"""
|
||||
{catInsert} ON CONFLICT (id) DO UPDATE
|
||||
SET name = EXCLUDED.name,
|
||||
slug = EXCLUDED.slug,
|
||||
description = EXCLUDED.description,
|
||||
parent_id = EXCLUDED.parent_id"""
|
||||
|> Sql.parameters
|
||||
[ webLogIdParam cat.WebLogId
|
||||
"@id", Sql.string (CategoryId.toString cat.Id)
|
||||
"@name", Sql.string cat.Name
|
||||
"@slug", Sql.string cat.Slug
|
||||
"@description", Sql.stringOrNone cat.Description
|
||||
"@parentId", Sql.stringOrNone (cat.ParentId |> Option.map CategoryId.toString) ]
|
||||
|> Sql.parameters (catParameters cat)
|
||||
|> Sql.executeNonQueryAsync
|
||||
()
|
||||
}
|
||||
|
||||
/// Restore categories from a backup
|
||||
let restore cats = backgroundTask {
|
||||
for cat in cats do
|
||||
do! save cat
|
||||
let! _ =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.executeTransactionAsync [
|
||||
catInsert, cats |> List.map catParameters
|
||||
]
|
||||
()
|
||||
}
|
||||
|
||||
interface ICategoryData with
|
||||
|
||||
@ -57,6 +57,39 @@ module Map =
|
||||
let toCount (row : RowReader) =
|
||||
row.int "the_count"
|
||||
|
||||
/// Create a custom feed from the current row
|
||||
let toCustomFeed (row : RowReader) : CustomFeed =
|
||||
{ Id = row.string "id" |> CustomFeedId
|
||||
Source = row.string "source" |> CustomFeedSource.parse
|
||||
Path = row.string "path" |> Permalink
|
||||
Podcast =
|
||||
match row.stringOrNone "title" with
|
||||
| Some title ->
|
||||
Some {
|
||||
Title = title
|
||||
Subtitle = row.stringOrNone "subtitle"
|
||||
ItemsInFeed = row.int "items_in_feed"
|
||||
Summary = row.string "summary"
|
||||
DisplayedAuthor = row.string "displayed_author"
|
||||
Email = row.string "email"
|
||||
ImageUrl = row.string "image_url" |> Permalink
|
||||
AppleCategory = row.string "apple_category"
|
||||
AppleSubcategory = row.stringOrNone "apple_subcategory"
|
||||
Explicit = row.string "explicit" |> ExplicitRating.parse
|
||||
DefaultMediaType = row.stringOrNone "default_media_type"
|
||||
MediaBaseUrl = row.stringOrNone "media_base_url"
|
||||
PodcastGuid = row.uuidOrNone "podcast_guid"
|
||||
FundingUrl = row.stringOrNone "funding_url"
|
||||
FundingText = row.stringOrNone "funding_text"
|
||||
Medium = row.stringOrNone "medium" |> Option.map PodcastMedium.parse
|
||||
}
|
||||
| None -> None
|
||||
}
|
||||
|
||||
/// Get a true/false value as to whether an item exists
|
||||
let toExists (row : RowReader) =
|
||||
row.bool "does_exist"
|
||||
|
||||
/// Create a meta item from the current row
|
||||
let toMetaItem (row : RowReader) : MetaItem =
|
||||
{ Name = row.string "name"
|
||||
@ -118,10 +151,65 @@ module Map =
|
||||
Text = row.string "revision_text" |> MarkupText.parse
|
||||
}
|
||||
|
||||
/// Create a tag mapping from the current row in the given data reader
|
||||
/// Create a tag mapping from the current row
|
||||
let toTagMap (row : RowReader) : TagMap =
|
||||
{ Id = row.string "id" |> TagMapId
|
||||
WebLogId = row.string "web_log_id" |> WebLogId
|
||||
Tag = row.string "tag"
|
||||
UrlValue = row.string "url_value"
|
||||
}
|
||||
|
||||
/// Create a theme from the current row (excludes templates)
|
||||
let toTheme (row : RowReader) : Theme =
|
||||
{ Theme.empty with
|
||||
Id = row.string "id" |> ThemeId
|
||||
Name = row.string "name"
|
||||
Version = row.string "version"
|
||||
}
|
||||
|
||||
/// Create a theme asset from the current row
|
||||
let toThemeAsset includeData (row : RowReader) : ThemeAsset =
|
||||
{ Id = ThemeAssetId (ThemeId (row.string "theme_id"), row.string "path")
|
||||
UpdatedOn = row.dateTime "updated_on"
|
||||
Data = if includeData then row.bytea "data" else [||]
|
||||
}
|
||||
|
||||
/// Create a theme template from the current row
|
||||
let toThemeTemplate includeText (row : RowReader) : ThemeTemplate =
|
||||
{ Name = row.string "name"
|
||||
Text = if includeText then row.string "template" else ""
|
||||
}
|
||||
|
||||
/// Create an uploaded file from the current row
|
||||
let toUpload includeData (row : RowReader) : Upload =
|
||||
{ Id = row.string "id" |> UploadId
|
||||
WebLogId = row.string "web_log_id" |> WebLogId
|
||||
Path = row.string "path" |> Permalink
|
||||
UpdatedOn = row.dateTime "updated_on"
|
||||
Data = if includeData then row.bytea "data" else [||]
|
||||
}
|
||||
|
||||
/// Create a web log from the current row
|
||||
let toWebLog (row : RowReader) : WebLog =
|
||||
{ Id = row.string "id" |> WebLogId
|
||||
Name = row.string "name"
|
||||
Slug = row.string "slug"
|
||||
Subtitle = row.stringOrNone "subtitle"
|
||||
DefaultPage = row.string "default_page"
|
||||
PostsPerPage = row.int "posts_per_page"
|
||||
ThemeId = row.string "theme_id" |> ThemeId
|
||||
UrlBase = row.string "url_base"
|
||||
TimeZone = row.string "time_zone"
|
||||
AutoHtmx = row.bool "auto_htmx"
|
||||
Uploads = row.string "uploads" |> UploadDestination.parse
|
||||
Rss = {
|
||||
IsFeedEnabled = row.bool "is_feed_enabled"
|
||||
FeedName = row.string "feed_name"
|
||||
ItemsInFeed = row.intOrNone "items_in_feed"
|
||||
IsCategoryEnabled = row.bool "is_category_enabled"
|
||||
IsTagEnabled = row.bool "is_tag_enabled"
|
||||
Copyright = row.stringOrNone "copyright"
|
||||
CustomFeeds = []
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@ -25,6 +25,16 @@ type PostgreSqlPageData (conn : NpgsqlConnection) =
|
||||
let pageWithoutText row =
|
||||
{ Map.toPage row with Text = "" }
|
||||
|
||||
/// The INSERT statement for a page revision
|
||||
let revInsert = "INSERT INTO page_revision VALUES (@pageId, @asOf, @text)"
|
||||
|
||||
/// Parameters for a revision INSERT statement
|
||||
let revParams pageId rev = [
|
||||
"@pageId", Sql.string (PageId.toString pageId)
|
||||
"@asOf", Sql.timestamptz rev.AsOf
|
||||
"@text", Sql.string (MarkupText.toString rev.Text)
|
||||
]
|
||||
|
||||
/// Update a page's revisions
|
||||
let updatePageRevisions pageId oldRevs newRevs = backgroundTask {
|
||||
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
|
||||
@ -40,13 +50,7 @@ type PostgreSqlPageData (conn : NpgsqlConnection) =
|
||||
"@asOf", Sql.timestamptz it.AsOf
|
||||
])
|
||||
if not (List.isEmpty toAdd) then
|
||||
"INSERT INTO page_revision VALUES (@pageId, @asOf, @text)",
|
||||
toAdd
|
||||
|> List.map (fun it -> [
|
||||
"@pageId", Sql.string (PageId.toString pageId)
|
||||
"@asOf", Sql.timestamptz it.AsOf
|
||||
"@text", Sql.string (MarkupText.toString it.Text)
|
||||
])
|
||||
revInsert, toAdd |> List.map (revParams pageId)
|
||||
]
|
||||
()
|
||||
}
|
||||
@ -173,19 +177,39 @@ type PostgreSqlPageData (conn : NpgsqlConnection) =
|
||||
|> Sql.parameters [ webLogIdParam webLogId; "@pageSize", Sql.int 26; "@toSkip", Sql.int ((pageNbr - 1) * 25) ]
|
||||
|> Sql.executeAsync Map.toPage
|
||||
|
||||
/// The INSERT statement for a page
|
||||
let pageInsert = """
|
||||
INSERT INTO page (
|
||||
id, web_log_id, author_id, title, permalink, prior_permalinks, published_on, updated_on, is_in_page_list,
|
||||
template, page_text, meta_items
|
||||
) VALUES (
|
||||
@id, @webLogId, @authorId, @title, @permalink, @priorPermalinks, @publishedOn, @updatedOn, @isInPageList,
|
||||
@template, @text, @metaItems
|
||||
)"""
|
||||
|
||||
/// The parameters for saving a page
|
||||
let pageParams (page : Page) = [
|
||||
webLogIdParam page.WebLogId
|
||||
"@id", Sql.string (PageId.toString page.Id)
|
||||
"@authorId", Sql.string (WebLogUserId.toString page.AuthorId)
|
||||
"@title", Sql.string page.Title
|
||||
"@permalink", Sql.string (Permalink.toString page.Permalink)
|
||||
"@publishedOn", Sql.timestamptz page.PublishedOn
|
||||
"@updatedOn", Sql.timestamptz page.UpdatedOn
|
||||
"@isInPageList", Sql.bool page.IsInPageList
|
||||
"@template", Sql.stringOrNone page.Template
|
||||
"@text", Sql.string page.Text
|
||||
"@metaItems", Sql.jsonb (JsonConvert.SerializeObject page.Metadata)
|
||||
"@priorPermalinks", Sql.stringArray (page.PriorPermalinks |> List.map Permalink.toString |> Array.ofList)
|
||||
]
|
||||
|
||||
/// Save a page
|
||||
let save (page : Page) = backgroundTask {
|
||||
let! oldPage = findFullById page.Id page.WebLogId
|
||||
let! _ =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.query """
|
||||
INSERT INTO page (
|
||||
id, web_log_id, author_id, title, permalink, prior_permalinks, published_on, updated_on,
|
||||
is_in_page_list, template, page_text, meta_items
|
||||
) VALUES (
|
||||
@id, @webLogId, @authorId, @title, @permalink, @priorPermalinks, @publishedOn, @updatedOn,
|
||||
@isInPageList, @template, @text, @metaItems
|
||||
) ON CONFLICT (id) DO UPDATE
|
||||
|> Sql.query $"""
|
||||
{pageInsert} ON CONFLICT (id) DO UPDATE
|
||||
SET author_id = EXCLUDED.author_id,
|
||||
title = EXCLUDED.title,
|
||||
permalink = EXCLUDED.permalink,
|
||||
@ -196,29 +220,22 @@ type PostgreSqlPageData (conn : NpgsqlConnection) =
|
||||
template = EXCLUDED.template,
|
||||
page_text = EXCLUDED.text,
|
||||
meta_items = EXCLUDED.meta_items"""
|
||||
|> Sql.parameters
|
||||
[ webLogIdParam page.WebLogId
|
||||
"@id", Sql.string (PageId.toString page.Id)
|
||||
"@authorId", Sql.string (WebLogUserId.toString page.AuthorId)
|
||||
"@title", Sql.string page.Title
|
||||
"@permalink", Sql.string (Permalink.toString page.Permalink)
|
||||
"@publishedOn", Sql.timestamptz page.PublishedOn
|
||||
"@updatedOn", Sql.timestamptz page.UpdatedOn
|
||||
"@isInPageList", Sql.bool page.IsInPageList
|
||||
"@template", Sql.stringOrNone page.Template
|
||||
"@text", Sql.string page.Text
|
||||
"@metaItems", Sql.jsonb (JsonConvert.SerializeObject page.Metadata)
|
||||
"@priorPermalinks",
|
||||
Sql.stringArray (page.PriorPermalinks |> List.map Permalink.toString |> Array.ofList) ]
|
||||
|> Sql.parameters (pageParams page)
|
||||
|> Sql.executeNonQueryAsync
|
||||
do! updatePageRevisions page.Id (match oldPage with Some p -> p.Revisions | None -> []) page.Revisions
|
||||
()
|
||||
}
|
||||
|
||||
/// Restore pages from a backup
|
||||
let restore pages = backgroundTask {
|
||||
for page in pages do
|
||||
do! save page
|
||||
let restore (pages : Page list) = backgroundTask {
|
||||
let revisions = pages |> List.collect (fun p -> p.Revisions |> List.map (fun r -> p.Id, r))
|
||||
let! _ =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.executeTransactionAsync [
|
||||
pageInsert, pages |> List.map pageParams
|
||||
revInsert, revisions |> List.map (fun (pageId, rev) -> revParams pageId rev)
|
||||
]
|
||||
()
|
||||
}
|
||||
|
||||
/// Update a page's prior permalinks
|
||||
|
||||
@ -31,28 +31,41 @@ type PostgreSqlPostData (conn : NpgsqlConnection) =
|
||||
let postWithoutText row =
|
||||
{ Map.toPost row with Text = "" }
|
||||
|
||||
/// The INSERT statement for a post/category cross-reference
|
||||
let catInsert = "INSERT INTO post_category VALUES (@postId, @categoryId)"
|
||||
|
||||
/// Parameters for adding or updating a post/category cross-reference
|
||||
let catParams postId cat = [
|
||||
"@postId", Sql.string (PostId.toString postId)
|
||||
"categoryId", Sql.string (CategoryId.toString cat)
|
||||
]
|
||||
|
||||
/// Update a post's assigned categories
|
||||
let updatePostCategories postId oldCats newCats = backgroundTask {
|
||||
let toDelete, toAdd = Utils.diffLists oldCats newCats CategoryId.toString
|
||||
if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then
|
||||
let catParams cats =
|
||||
cats
|
||||
|> List.map (fun it -> [
|
||||
"@postId", Sql.string (PostId.toString postId)
|
||||
"categoryId", Sql.string (CategoryId.toString it)
|
||||
])
|
||||
let! _ =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.executeTransactionAsync [
|
||||
if not (List.isEmpty toDelete) then
|
||||
"DELETE FROM post_category WHERE post_id = @postId AND category_id = @categoryId",
|
||||
catParams toDelete
|
||||
toDelete |> List.map (catParams postId)
|
||||
if not (List.isEmpty toAdd) then
|
||||
"INSERT INTO post_category VALUES (@postId, @categoryId)", catParams toAdd
|
||||
catInsert, toAdd |> List.map (catParams postId)
|
||||
]
|
||||
()
|
||||
}
|
||||
|
||||
/// The INSERT statement for a post revision
|
||||
let revInsert = "INSERT INTO post_revision VALUES (@postId, @asOf, @text)"
|
||||
|
||||
/// The parameters for adding a post revision
|
||||
let revParams postId rev = [
|
||||
"@postId", Sql.string (PostId.toString postId)
|
||||
"@asOf", Sql.timestamptz rev.AsOf
|
||||
"@text", Sql.string (MarkupText.toString rev.Text)
|
||||
]
|
||||
|
||||
/// Update a post's revisions
|
||||
let updatePostRevisions postId oldRevs newRevs = backgroundTask {
|
||||
let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs
|
||||
@ -68,13 +81,7 @@ type PostgreSqlPostData (conn : NpgsqlConnection) =
|
||||
"@asOf", Sql.timestamptz it.AsOf
|
||||
])
|
||||
if not (List.isEmpty toAdd) then
|
||||
"INSERT INTO post_revision VALUES (@postId, @asOf, @text)",
|
||||
toAdd
|
||||
|> List.map (fun it -> [
|
||||
"@postId", Sql.string (PostId.toString postId)
|
||||
"@asOf", Sql.timestamptz it.AsOf
|
||||
"@text", Sql.string (MarkupText.toString it.Text)
|
||||
])
|
||||
revInsert, toAdd |> List.map (revParams postId)
|
||||
]
|
||||
()
|
||||
}
|
||||
@ -259,19 +266,43 @@ type PostgreSqlPostData (conn : NpgsqlConnection) =
|
||||
return List.tryHead older, List.tryHead newer
|
||||
}
|
||||
|
||||
/// The INSERT statement for a post
|
||||
let postInsert = """
|
||||
INSERT INTO post (
|
||||
id, web_log_id, author_id, status, title, permalink, prior_permalinks, published_on, updated_on,
|
||||
template, post_text, tags, meta_items, episode
|
||||
) VALUES (
|
||||
@id, @webLogId, @authorId, @status, @title, @permalink, @priorPermalinks, @publishedOn, @updatedOn,
|
||||
@template, @text, @tags, @metaItems, @episode
|
||||
)"""
|
||||
|
||||
/// The parameters for saving a post
|
||||
let postParams (post : Post) = [
|
||||
webLogIdParam post.WebLogId
|
||||
"@id", Sql.string (PostId.toString post.Id)
|
||||
"@authorId", Sql.string (WebLogUserId.toString post.AuthorId)
|
||||
"@status", Sql.string (PostStatus.toString post.Status)
|
||||
"@title", Sql.string post.Title
|
||||
"@permalink", Sql.string (Permalink.toString post.Permalink)
|
||||
"@publishedOn", Sql.timestamptzOrNone post.PublishedOn
|
||||
"@updatedOn", Sql.timestamptz post.UpdatedOn
|
||||
"@template", Sql.stringOrNone post.Template
|
||||
"@text", Sql.string post.Text
|
||||
"@episode", Sql.jsonbOrNone (post.Episode |> Option.map JsonConvert.SerializeObject)
|
||||
"@priorPermalinks", Sql.stringArray (post.PriorPermalinks |> List.map Permalink.toString |> Array.ofList)
|
||||
"@tags", Sql.stringArrayOrNone (if List.isEmpty post.Tags then None else Some (Array.ofList post.Tags))
|
||||
"@metaItems",
|
||||
if List.isEmpty post.Metadata then None else Some (JsonConvert.SerializeObject post.Metadata)
|
||||
|> Sql.jsonbOrNone
|
||||
]
|
||||
|
||||
/// Save a post
|
||||
let save (post : Post) = backgroundTask {
|
||||
let! oldPost = findFullById post.Id post.WebLogId
|
||||
let! _ =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.query """
|
||||
INSERT INTO post (
|
||||
id, web_log_id, author_id, status, title, permalink, prior_permalinks, published_on, updated_on,
|
||||
template, post_text, tags, meta_items, episode
|
||||
) VALUES (
|
||||
@id, @webLogId, @authorId, @status, @title, @permalink, @priorPermalinks, @publishedOn, @updatedOn,
|
||||
@template, @text, @tags, @metaItems, @episode
|
||||
) ON CONFLICT (id) DO UPDATE
|
||||
|> Sql.query $"""
|
||||
{postInsert} ON CONFLICT (id) DO UPDATE
|
||||
SET author_id = EXCLUDED.author_id,
|
||||
status = EXCLUDED.status,
|
||||
title = EXCLUDED.title,
|
||||
@ -284,26 +315,7 @@ type PostgreSqlPostData (conn : NpgsqlConnection) =
|
||||
tags = EXCLUDED.tags,
|
||||
meta_items = EXCLUDED.meta_items,
|
||||
episode = EXCLUDED.episode"""
|
||||
|> Sql.parameters
|
||||
[ webLogIdParam post.WebLogId
|
||||
"@id", Sql.string (PostId.toString post.Id)
|
||||
"@authorId", Sql.string (WebLogUserId.toString post.AuthorId)
|
||||
"@status", Sql.string (PostStatus.toString post.Status)
|
||||
"@title", Sql.string post.Title
|
||||
"@permalink", Sql.string (Permalink.toString post.Permalink)
|
||||
"@publishedOn", Sql.timestamptzOrNone post.PublishedOn
|
||||
"@updatedOn", Sql.timestamptz post.UpdatedOn
|
||||
"@template", Sql.stringOrNone post.Template
|
||||
"@text", Sql.string post.Text
|
||||
"@episode", Sql.jsonbOrNone (post.Episode |> Option.map JsonConvert.SerializeObject)
|
||||
"@priorPermalinks",
|
||||
Sql.stringArray (post.PriorPermalinks |> List.map Permalink.toString |> Array.ofList)
|
||||
"@tags",
|
||||
Sql.stringArrayOrNone (if List.isEmpty post.Tags then None else Some (Array.ofList post.Tags))
|
||||
"@metaItems",
|
||||
if List.isEmpty post.Metadata then None else Some (JsonConvert.SerializeObject post.Metadata)
|
||||
|> Sql.jsonbOrNone
|
||||
]
|
||||
|> Sql.parameters (postParams post)
|
||||
|> Sql.executeNonQueryAsync
|
||||
do! updatePostCategories post.Id (match oldPost with Some p -> p.CategoryIds | None -> []) post.CategoryIds
|
||||
do! updatePostRevisions post.Id (match oldPost with Some p -> p.Revisions | None -> []) post.Revisions
|
||||
@ -311,8 +323,16 @@ type PostgreSqlPostData (conn : NpgsqlConnection) =
|
||||
|
||||
/// Restore posts from a backup
|
||||
let restore posts = backgroundTask {
|
||||
for post in posts do
|
||||
do! save post
|
||||
let cats = posts |> List.collect (fun p -> p.CategoryIds |> List.map (fun c -> p.Id, c))
|
||||
let revisions = posts |> List.collect (fun p -> p.Revisions |> List.map (fun r -> p.Id, r))
|
||||
let! _ =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.executeTransactionAsync [
|
||||
postInsert, posts |> List.map postParams
|
||||
catInsert, cats |> List.map (fun (postId, catId) -> catParams postId catId)
|
||||
revInsert, revisions |> List.map (fun (postId, rev) -> revParams postId rev)
|
||||
]
|
||||
()
|
||||
}
|
||||
|
||||
/// Update prior permalinks for a post
|
||||
|
||||
@ -56,32 +56,43 @@ type PostgreSqlTagMapData (conn : NpgsqlConnection) =
|
||||
|> Sql.parameters (webLogIdParam webLogId :: tagParams)
|
||||
|> Sql.executeAsync Map.toTagMap
|
||||
|
||||
/// The INSERT statement for a tag mapping
|
||||
let tagMapInsert = """
|
||||
INSERT INTO tag_map (
|
||||
id, web_log_id, tag, url_value
|
||||
) VALUES (
|
||||
@id, @webLogId, @tag, @urlValue
|
||||
)"""
|
||||
|
||||
/// The parameters for saving a tag mapping
|
||||
let tagMapParams (tagMap : TagMap) = [
|
||||
webLogIdParam tagMap.WebLogId
|
||||
"@id", Sql.string (TagMapId.toString tagMap.Id)
|
||||
"@tag", Sql.string tagMap.Tag
|
||||
"@urlValue", Sql.string tagMap.UrlValue
|
||||
]
|
||||
|
||||
/// Save a tag mapping
|
||||
let save (tagMap : TagMap) = backgroundTask {
|
||||
let save tagMap = backgroundTask {
|
||||
let! _ =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.query """
|
||||
INSERT INTO tag_map (
|
||||
id, web_log_id, tag, url_value
|
||||
) VALUES (
|
||||
@id, @webLogId, @tag, @urlValue
|
||||
) ON CONFLICT (id) DO UPDATE
|
||||
|> Sql.query $"""
|
||||
{tagMapInsert} ON CONFLICT (id) DO UPDATE
|
||||
SET tag = EXCLUDED.tag,
|
||||
url_value = EXCLUDED.url_value"""
|
||||
|> Sql.parameters
|
||||
[ webLogIdParam tagMap.WebLogId
|
||||
"@id", Sql.string (TagMapId.toString tagMap.Id)
|
||||
"@tag", Sql.string tagMap.Tag
|
||||
"@urlValue", Sql.string tagMap.UrlValue
|
||||
]
|
||||
|> Sql.parameters (tagMapParams tagMap)
|
||||
|> Sql.executeNonQueryAsync
|
||||
()
|
||||
}
|
||||
|
||||
/// Restore tag mappings from a backup
|
||||
let restore tagMaps = backgroundTask {
|
||||
for tagMap in tagMaps do
|
||||
do! save tagMap
|
||||
let! _ =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.executeTransactionAsync [
|
||||
tagMapInsert, tagMaps |> List.map tagMapParams
|
||||
]
|
||||
()
|
||||
}
|
||||
|
||||
interface ITagMapData with
|
||||
|
||||
204
src/MyWebLog.Data/PostgreSql/PostgreSqlThemeData.fs
Normal file
204
src/MyWebLog.Data/PostgreSql/PostgreSqlThemeData.fs
Normal file
@ -0,0 +1,204 @@
|
||||
namespace MyWebLog.Data.PostgreSql
|
||||
|
||||
open MyWebLog
|
||||
open MyWebLog.Data
|
||||
open Npgsql
|
||||
open Npgsql.FSharp
|
||||
|
||||
/// PostreSQL myWebLog theme data implementation
|
||||
type PostgreSqlThemeData (conn : NpgsqlConnection) =
|
||||
|
||||
/// Retrieve all themes (except 'admin'; excludes template text)
|
||||
let all () = backgroundTask {
|
||||
let! themes =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.query "SELECT * FROM theme WHERE id <> 'admin' ORDER BY id"
|
||||
|> Sql.executeAsync Map.toTheme
|
||||
let! templates =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.query "SELECT name, theme_id FROM theme_template WHERE theme_id <> 'admin' ORDER BY name"
|
||||
|> Sql.executeAsync (fun row -> ThemeId (row.string "theme_id"), Map.toThemeTemplate false row)
|
||||
return
|
||||
themes
|
||||
|> List.map (fun t ->
|
||||
{ t with Templates = templates |> List.filter (fun tt -> fst tt = t.Id) |> List.map snd })
|
||||
}
|
||||
|
||||
/// Does a given theme exist?
|
||||
let exists themeId =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.query "SELECT EXISTS (SELECT 1 FROM theme WHERE id = @id) AS does_exist"
|
||||
|> Sql.parameters [ "@id", Sql.string (ThemeId.toString themeId) ]
|
||||
|> Sql.executeRowAsync Map.toExists
|
||||
|
||||
/// Find a theme by its ID
|
||||
let findById themeId = backgroundTask {
|
||||
let themeIdParam = [ "@id", Sql.string (ThemeId.toString themeId) ]
|
||||
let! tryTheme =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.query "SELECT * FROM theme WHERE id = @id"
|
||||
|> Sql.parameters themeIdParam
|
||||
|> Sql.executeAsync Map.toTheme
|
||||
match List.tryHead tryTheme with
|
||||
| Some theme ->
|
||||
let! templates =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.query "SELECT * FROM theme_template WHERE theme_id = @id"
|
||||
|> Sql.parameters themeIdParam
|
||||
|> Sql.executeAsync (Map.toThemeTemplate true)
|
||||
return Some { theme with Templates = templates }
|
||||
| None -> return None
|
||||
}
|
||||
|
||||
/// Find a theme by its ID (excludes the text of templates)
|
||||
let findByIdWithoutText themeId = backgroundTask {
|
||||
match! findById themeId with
|
||||
| Some theme ->
|
||||
return Some {
|
||||
theme with Templates = theme.Templates |> List.map (fun t -> { t with Text = "" })
|
||||
}
|
||||
| None -> return None
|
||||
}
|
||||
|
||||
/// Delete a theme by its ID
|
||||
let delete themeId = backgroundTask {
|
||||
match! findByIdWithoutText themeId with
|
||||
| Some _ ->
|
||||
let! _ =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.query """
|
||||
DELETE FROM theme_asset WHERE theme_id = @id;
|
||||
DELETE FROM theme_template WHERE theme_id = @id;
|
||||
DELETE FROM theme WHERE id = @id"""
|
||||
|> Sql.parameters [ "@id", Sql.string (ThemeId.toString themeId) ]
|
||||
|> Sql.executeNonQueryAsync
|
||||
return true
|
||||
| None -> return false
|
||||
}
|
||||
|
||||
/// Save a theme
|
||||
let save (theme : Theme) = backgroundTask {
|
||||
let! oldTheme = findById theme.Id
|
||||
let themeIdParam = Sql.string (ThemeId.toString theme.Id)
|
||||
let! _ =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.query """
|
||||
INSERT INTO theme VALUES (@id, @name, @version)
|
||||
ON CONFLICT (id) DO UPDATE
|
||||
SET name = EXCLUDED.name,
|
||||
version = EXCLUDED.version"""
|
||||
|> Sql.parameters
|
||||
[ "@id", themeIdParam
|
||||
"@name", Sql.string theme.Name
|
||||
"@version", Sql.string theme.Version ]
|
||||
|> Sql.executeNonQueryAsync
|
||||
|
||||
let toDelete, _ =
|
||||
Utils.diffLists (oldTheme |> Option.map (fun t -> t.Templates) |> Option.defaultValue [])
|
||||
theme.Templates (fun t -> t.Name)
|
||||
let toAddOrUpdate =
|
||||
theme.Templates
|
||||
|> List.filter (fun t -> not (toDelete |> List.exists (fun d -> d.Name = t.Name)))
|
||||
|
||||
if not (List.isEmpty toDelete) || not (List.isEmpty toAddOrUpdate) then
|
||||
let! _ =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.executeTransactionAsync [
|
||||
if not (List.isEmpty toDelete) then
|
||||
"DELETE FROM theme_template WHERE theme_id = @themeId AND name = @name",
|
||||
toDelete |> List.map (fun tmpl -> [ "@themeId", themeIdParam; "@name", Sql.string tmpl.Name ])
|
||||
if not (List.isEmpty toAddOrUpdate) then
|
||||
"""INSERT INTO theme_template VALUES (@themeId, @name, @template)
|
||||
ON CONFLICT (theme_id, name) DO UPDATE
|
||||
SET template = EXCLUDED.template""",
|
||||
toAddOrUpdate |> List.map (fun tmpl -> [
|
||||
"@themeId", themeIdParam
|
||||
"@name", Sql.string tmpl.Name
|
||||
"@template", Sql.string tmpl.Text
|
||||
])
|
||||
]
|
||||
()
|
||||
}
|
||||
|
||||
interface IThemeData with
|
||||
member _.All () = all ()
|
||||
member _.Delete themeId = delete themeId
|
||||
member _.Exists themeId = exists themeId
|
||||
member _.FindById themeId = findById themeId
|
||||
member _.FindByIdWithoutText themeId = findByIdWithoutText themeId
|
||||
member _.Save theme = save theme
|
||||
|
||||
|
||||
/// PostreSQL myWebLog theme data implementation
|
||||
type PostgreSqlThemeAssetData (conn : NpgsqlConnection) =
|
||||
|
||||
/// Get all theme assets (excludes data)
|
||||
let all () =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.query "SELECT theme_id, path, updated_on FROM theme_asset"
|
||||
|> Sql.executeAsync (Map.toThemeAsset false)
|
||||
|
||||
/// Delete all assets for the given theme
|
||||
let deleteByTheme themeId = backgroundTask {
|
||||
let! _ =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.query "DELETE FROM theme_asset WHERE theme_id = @themeId"
|
||||
|> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ]
|
||||
|> Sql.executeNonQueryAsync
|
||||
()
|
||||
}
|
||||
|
||||
/// Find a theme asset by its ID
|
||||
let findById assetId = backgroundTask {
|
||||
let (ThemeAssetId (ThemeId themeId, path)) = assetId
|
||||
let! asset =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.query "SELECT * FROM theme_asset WHERE theme_id = @themeId AND path = @path"
|
||||
|> Sql.parameters [ "@themeId", Sql.string themeId; "@path", Sql.string path ]
|
||||
|> Sql.executeAsync (Map.toThemeAsset true)
|
||||
return List.tryHead asset
|
||||
}
|
||||
|
||||
/// Get theme assets for the given theme (excludes data)
|
||||
let findByTheme themeId =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.query "SELECT theme_id, path, updated_on FROM theme_asset WHERE theme_id = @themeId"
|
||||
|> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ]
|
||||
|> Sql.executeAsync (Map.toThemeAsset false)
|
||||
|
||||
/// Get theme assets for the given theme
|
||||
let findByThemeWithData themeId =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.query "SELECT * FROM theme_asset WHERE theme_id = @themeId"
|
||||
|> Sql.parameters [ "@themeId", Sql.string (ThemeId.toString themeId) ]
|
||||
|> Sql.executeAsync (Map.toThemeAsset true)
|
||||
|
||||
/// Save a theme asset
|
||||
let save (asset : ThemeAsset) = backgroundTask {
|
||||
let (ThemeAssetId (ThemeId themeId, path)) = asset.Id
|
||||
let! _ =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.query """
|
||||
INSERT INTO theme_asset (
|
||||
theme_id, path, updated_on, data
|
||||
) VALUES (
|
||||
@themeId, @path, @updatedOn, @data
|
||||
) ON CONFLICT (theme_id, path) DO UPDATE
|
||||
SET updated_on = EXCLUDED.updated_on,
|
||||
data = EXCLUDED.data"""
|
||||
|> Sql.parameters
|
||||
[ "@themeId", Sql.string themeId
|
||||
"@path", Sql.string path
|
||||
"@updatedOn", Sql.timestamptz asset.UpdatedOn
|
||||
"@data", Sql.bytea asset.Data ]
|
||||
|> Sql.executeNonQueryAsync
|
||||
()
|
||||
}
|
||||
|
||||
interface IThemeAssetData with
|
||||
member _.All () = all ()
|
||||
member _.DeleteByTheme themeId = deleteByTheme themeId
|
||||
member _.FindById assetId = findById assetId
|
||||
member _.FindByTheme themeId = findByTheme themeId
|
||||
member _.FindByThemeWithData themeId = findByThemeWithData themeId
|
||||
member _.Save asset = save asset
|
||||
99
src/MyWebLog.Data/PostgreSql/PostgreSqlUploadData.fs
Normal file
99
src/MyWebLog.Data/PostgreSql/PostgreSqlUploadData.fs
Normal file
@ -0,0 +1,99 @@
|
||||
namespace MyWebLog.Data.PostgreSql
|
||||
|
||||
open MyWebLog
|
||||
open MyWebLog.Data
|
||||
open Npgsql
|
||||
open Npgsql.FSharp
|
||||
|
||||
/// PostgreSQL myWebLog uploaded file data implementation
|
||||
type PostgreSqlUploadData (conn : NpgsqlConnection) =
|
||||
|
||||
/// The INSERT statement for an uploaded file
|
||||
let upInsert = """
|
||||
INSERT INTO upload (
|
||||
id, web_log_id, path, updated_on, data
|
||||
) VALUES (
|
||||
@id, @webLogId, @path, @updatedOn, @data
|
||||
)"""
|
||||
|
||||
/// Parameters for adding an uploaded file
|
||||
let upParams (upload : Upload) = [
|
||||
webLogIdParam upload.WebLogId
|
||||
"@id", Sql.string (UploadId.toString upload.Id)
|
||||
"@path", Sql.string (Permalink.toString upload.Path)
|
||||
"@updatedOn", Sql.timestamptz upload.UpdatedOn
|
||||
"@data", Sql.bytea upload.Data
|
||||
]
|
||||
|
||||
/// Save an uploaded file
|
||||
let add upload = backgroundTask {
|
||||
let! _ =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.query upInsert
|
||||
|> Sql.parameters (upParams upload)
|
||||
|> Sql.executeNonQueryAsync
|
||||
()
|
||||
}
|
||||
|
||||
/// Delete an uploaded file by its ID
|
||||
let delete uploadId webLogId = backgroundTask {
|
||||
let theParams = [ "@id", Sql.string (UploadId.toString uploadId); webLogIdParam webLogId ]
|
||||
let! tryPath =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.query "SELECT path FROM upload WHERE id = @id AND web_log_id = @webLogId"
|
||||
|> Sql.parameters theParams
|
||||
|> Sql.executeAsync (fun row -> row.string "path")
|
||||
match List.tryHead tryPath with
|
||||
| Some path ->
|
||||
let! _ =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.query "DELETE FROM upload WHERE id = @id AND web_log_id = @webLogId"
|
||||
|> Sql.parameters theParams
|
||||
|> Sql.executeNonQueryAsync
|
||||
return Ok path
|
||||
| None -> return Error $"""Upload ID {UploadId.toString uploadId} not found"""
|
||||
}
|
||||
|
||||
/// Find an uploaded file by its path for the given web log
|
||||
let findByPath (path : string) webLogId = backgroundTask {
|
||||
let! upload =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.query "SELECT * FROM upload WHERE web_log_id = @webLogId AND path = @path"
|
||||
|> Sql.parameters [ webLogIdParam webLogId; "@path", Sql.string path ]
|
||||
|> Sql.executeAsync (Map.toUpload true)
|
||||
return List.tryHead upload
|
||||
}
|
||||
|
||||
/// Find all uploaded files for the given web log (excludes data)
|
||||
let findByWebLog webLogId =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.query "SELECT id, web_log_id, path, updated_on FROM upload WHERE web_log_id = @webLogId"
|
||||
|> Sql.parameters [ webLogIdParam webLogId ]
|
||||
|> Sql.executeAsync (Map.toUpload false)
|
||||
|
||||
/// Find all uploaded files for the given web log
|
||||
let findByWebLogWithData webLogId =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.query "SELECT * FROM upload WHERE web_log_id = @webLogId"
|
||||
|> Sql.parameters [ webLogIdParam webLogId ]
|
||||
|> Sql.executeAsync (Map.toUpload true)
|
||||
|
||||
/// Restore uploads from a backup
|
||||
let restore uploads = backgroundTask {
|
||||
for batch in uploads |> List.chunkBySize 5 do
|
||||
let! _ =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.executeTransactionAsync [
|
||||
upInsert, batch |> List.map upParams
|
||||
]
|
||||
()
|
||||
}
|
||||
|
||||
interface IUploadData with
|
||||
member _.Add upload = add upload
|
||||
member _.Delete uploadId webLogId = delete uploadId webLogId
|
||||
member _.FindByPath path webLogId = findByPath path webLogId
|
||||
member _.FindByWebLog webLogId = findByWebLog webLogId
|
||||
member _.FindByWebLogWithData webLogId = findByWebLogWithData webLogId
|
||||
member _.Restore uploads = restore uploads
|
||||
|
||||
326
src/MyWebLog.Data/PostgreSql/PostgreSqlWebLogData.fs
Normal file
326
src/MyWebLog.Data/PostgreSql/PostgreSqlWebLogData.fs
Normal file
@ -0,0 +1,326 @@
|
||||
namespace MyWebLog.Data.PostgreSql
|
||||
|
||||
open MyWebLog
|
||||
open MyWebLog.Data
|
||||
open Npgsql
|
||||
open Npgsql.FSharp
|
||||
|
||||
// The web log podcast insert loop is not statically compilable; this is OK
|
||||
//#nowarn "3511"
|
||||
|
||||
/// PostgreSQL myWebLog web log data implementation
|
||||
type PostgreSqlWebLogData (conn : NpgsqlConnection) =
|
||||
|
||||
// SUPPORT FUNCTIONS
|
||||
|
||||
/// Add parameters for web log INSERT or web log/RSS options UPDATE statements
|
||||
let addWebLogRssParameters (webLog : WebLog) =
|
||||
[ cmd.Parameters.AddWithValue ("@isFeedEnabled", webLog.Rss.IsFeedEnabled)
|
||||
cmd.Parameters.AddWithValue ("@feedName", webLog.Rss.FeedName)
|
||||
cmd.Parameters.AddWithValue ("@itemsInFeed", maybe webLog.Rss.ItemsInFeed)
|
||||
cmd.Parameters.AddWithValue ("@isCategoryEnabled", webLog.Rss.IsCategoryEnabled)
|
||||
cmd.Parameters.AddWithValue ("@isTagEnabled", webLog.Rss.IsTagEnabled)
|
||||
cmd.Parameters.AddWithValue ("@copyright", maybe webLog.Rss.Copyright)
|
||||
] |> ignore
|
||||
|
||||
/// Add parameters for web log INSERT or UPDATE statements
|
||||
let addWebLogParameters (webLog : WebLog) =
|
||||
[ cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id)
|
||||
cmd.Parameters.AddWithValue ("@name", webLog.Name)
|
||||
cmd.Parameters.AddWithValue ("@slug", webLog.Slug)
|
||||
cmd.Parameters.AddWithValue ("@subtitle", maybe webLog.Subtitle)
|
||||
cmd.Parameters.AddWithValue ("@defaultPage", webLog.DefaultPage)
|
||||
cmd.Parameters.AddWithValue ("@postsPerPage", webLog.PostsPerPage)
|
||||
cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString webLog.ThemeId)
|
||||
cmd.Parameters.AddWithValue ("@urlBase", webLog.UrlBase)
|
||||
cmd.Parameters.AddWithValue ("@timeZone", webLog.TimeZone)
|
||||
cmd.Parameters.AddWithValue ("@autoHtmx", webLog.AutoHtmx)
|
||||
cmd.Parameters.AddWithValue ("@uploads", UploadDestination.toString webLog.Uploads)
|
||||
] |> ignore
|
||||
addWebLogRssParameters cmd webLog
|
||||
|
||||
/// Add parameters for custom feed INSERT or UPDATE statements
|
||||
let addCustomFeedParameters (cmd : SqliteCommand) webLogId (feed : CustomFeed) =
|
||||
[ 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)
|
||||
] |> ignore
|
||||
|
||||
/// Get the current custom feeds for a web log
|
||||
let getCustomFeeds (webLog : WebLog) =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.query """
|
||||
SELECT f.*, p.*
|
||||
FROM web_log_feed f
|
||||
LEFT JOIN web_log_feed_podcast p ON p.feed_id = f.id
|
||||
WHERE f.web_log_id = @webLogId"""
|
||||
|> Sql.parameters [ webLogIdParam webLog.Id ]
|
||||
|> Sql.executeAsync Map.toCustomFeed
|
||||
|
||||
/// Append custom feeds to a web log
|
||||
let appendCustomFeeds (webLog : WebLog) = backgroundTask {
|
||||
let! feeds = getCustomFeeds webLog
|
||||
return { webLog with Rss = { webLog.Rss with CustomFeeds = feeds } }
|
||||
}
|
||||
|
||||
/// The INSERT statement for a podcast feed
|
||||
let feedInsert = """
|
||||
INSERT INTO web_log_feed_podcast (
|
||||
feed_id, title, subtitle, items_in_feed, summary, displayed_author, email, image_url, apple_category,
|
||||
apple_subcategory, explicit, default_media_type, media_base_url, podcast_guid, funding_url, funding_text,
|
||||
medium
|
||||
) VALUES (
|
||||
@feedId, @title, @subtitle, @itemsInFeed, @summary, @displayedAuthor, @email, @imageUrl, @appleCategory,
|
||||
@appleSubcategory, @explicit, @defaultMediaType, @mediaBaseUrl, @podcastGuid, @fundingUrl, @fundingText,
|
||||
@medium
|
||||
)"""
|
||||
|
||||
/// The parameters to save a podcast feed
|
||||
let feedParams feedId (podcast : PodcastOptions) = [
|
||||
"@feedId", Sql.string (CustomFeedId.toString feedId)
|
||||
"@title", Sql.string podcast.Title
|
||||
"@subtitle", Sql.stringOrNone podcast.Subtitle
|
||||
"@itemsInFeed", Sql.int podcast.ItemsInFeed
|
||||
"@summary", Sql.string podcast.Summary
|
||||
"@displayedAuthor", Sql.string podcast.DisplayedAuthor
|
||||
"@email", Sql.string podcast.Email
|
||||
"@imageUrl", Sql.string (Permalink.toString podcast.ImageUrl)
|
||||
"@appleCategory", Sql.string podcast.AppleCategory
|
||||
"@appleSubcategory", Sql.stringOrNone podcast.AppleSubcategory
|
||||
"@explicit", Sql.string (ExplicitRating.toString podcast.Explicit)
|
||||
"@defaultMediaType", Sql.stringOrNone podcast.DefaultMediaType
|
||||
"@mediaBaseUrl", Sql.stringOrNone podcast.MediaBaseUrl
|
||||
"@podcastGuid", Sql.uuidOrNone podcast.PodcastGuid
|
||||
"@fundingUrl", Sql.stringOrNone podcast.FundingUrl
|
||||
"@fundingText", Sql.stringOrNone podcast.FundingText
|
||||
"@medium", Sql.stringOrNone (podcast.Medium |> Option.map PodcastMedium.toString)
|
||||
]
|
||||
|
||||
/// Save a podcast for a custom feed
|
||||
let savePodcast feedId (podcast : PodcastOptions) = backgroundTask {
|
||||
let! _ =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.query $"""
|
||||
{feedInsert} ON CONFLICT (feed_id) DO UPDATE
|
||||
SET title = EXCLUDED.title,
|
||||
subtitle = EXCLUDED.subtitle,
|
||||
items_in_feed = EXCLUDED.items_in_feed,
|
||||
summary = EXCLUDED.summary,
|
||||
displayed_author = EXCLUDED.displayed_author,
|
||||
email = EXCLUDED.email,
|
||||
image_url = EXCLUDED.image_url,
|
||||
apple_category = EXCLUDED.apple_category,
|
||||
apple_subcategory = EXCLUDED.apple_subcategory,
|
||||
explicit = EXCLUDED.explicit,
|
||||
default_media_type = EXCLUDED.default_media_type,
|
||||
media_base_url = EXCLUDED.media_base_url,
|
||||
podcast_guid = EXCLUDED.podcast_guid,
|
||||
funding_url = EXCLUDED.funding_url,
|
||||
funding_text = EXCLUDED.funding_text,
|
||||
medium = EXCLUDED.medium"""
|
||||
|> Sql.parameters (feedParams feedId podcast)
|
||||
|> Sql.executeNonQueryAsync
|
||||
()
|
||||
}
|
||||
|
||||
/// Update the custom feeds for a web log
|
||||
let updateCustomFeeds (webLog : WebLog) = backgroundTask {
|
||||
let! feeds = getCustomFeeds webLog
|
||||
let toDelete, toAdd = Utils.diffLists feeds webLog.Rss.CustomFeeds (fun it -> $"{CustomFeedId.toString it.Id}")
|
||||
let toId (feed : CustomFeed) = feed.Id
|
||||
let toUpdate =
|
||||
webLog.Rss.CustomFeeds
|
||||
|> List.filter (fun f ->
|
||||
not (toDelete |> List.map toId |> List.append (toAdd |> List.map toId) |> List.contains f.Id))
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.Parameters.Add ("@id", SqliteType.Text) |> ignore
|
||||
toDelete
|
||||
|> List.map (fun it -> backgroundTask {
|
||||
cmd.CommandText <- """
|
||||
DELETE FROM web_log_feed_podcast WHERE feed_id = @id;
|
||||
DELETE FROM web_log_feed WHERE id = @id"""
|
||||
cmd.Parameters["@id"].Value <- CustomFeedId.toString it.Id
|
||||
do! write cmd
|
||||
})
|
||||
|> Task.WhenAll
|
||||
|> ignore
|
||||
cmd.Parameters.Clear ()
|
||||
toAdd
|
||||
|> List.map (fun it -> backgroundTask {
|
||||
cmd.CommandText <- """
|
||||
INSERT INTO web_log_feed (
|
||||
id, web_log_id, source, path
|
||||
) VALUES (
|
||||
@id, @webLogId, @source, @path
|
||||
)"""
|
||||
cmd.Parameters.Clear ()
|
||||
addCustomFeedParameters cmd webLog.Id it
|
||||
do! write cmd
|
||||
match it.Podcast with
|
||||
| Some podcast -> do! addPodcast it.Id podcast
|
||||
| None -> ()
|
||||
})
|
||||
|> Task.WhenAll
|
||||
|> ignore
|
||||
toUpdate
|
||||
|> List.map (fun it -> backgroundTask {
|
||||
cmd.CommandText <- """
|
||||
UPDATE web_log_feed
|
||||
SET source = @source,
|
||||
path = @path
|
||||
WHERE id = @id
|
||||
AND web_log_id = @webLogId"""
|
||||
cmd.Parameters.Clear ()
|
||||
addCustomFeedParameters cmd webLog.Id it
|
||||
do! write cmd
|
||||
let hadPodcast = Option.isSome (feeds |> List.find (fun f -> f.Id = it.Id)).Podcast
|
||||
match it.Podcast with
|
||||
| Some podcast -> do! savePodcast it.Id podcast
|
||||
| None ->
|
||||
if hadPodcast then
|
||||
cmd.CommandText <- "DELETE FROM web_log_feed_podcast WHERE feed_id = @id"
|
||||
cmd.Parameters.Clear ()
|
||||
cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString it.Id) |> ignore
|
||||
do! write cmd
|
||||
else
|
||||
()
|
||||
})
|
||||
|> Task.WhenAll
|
||||
|> ignore
|
||||
}
|
||||
|
||||
// IMPLEMENTATION FUNCTIONS
|
||||
|
||||
/// Add a web log
|
||||
let add webLog = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- """
|
||||
INSERT INTO web_log (
|
||||
id, name, slug, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone, auto_htmx,
|
||||
uploads, is_feed_enabled, feed_name, items_in_feed, is_category_enabled, is_tag_enabled, copyright
|
||||
) VALUES (
|
||||
@id, @name, @slug, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone, @autoHtmx,
|
||||
@uploads, @isFeedEnabled, @feedName, @itemsInFeed, @isCategoryEnabled, @isTagEnabled, @copyright
|
||||
)"""
|
||||
addWebLogParameters cmd webLog
|
||||
do! write cmd
|
||||
do! updateCustomFeeds webLog
|
||||
}
|
||||
|
||||
/// Retrieve all web logs
|
||||
let all () = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM web_log"
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
let! webLogs =
|
||||
toList Map.toWebLog rdr
|
||||
|> List.map (fun webLog -> backgroundTask { return! appendCustomFeeds webLog })
|
||||
|> Task.WhenAll
|
||||
return List.ofArray webLogs
|
||||
}
|
||||
|
||||
/// Delete a web log by its ID
|
||||
let delete webLogId = backgroundTask {
|
||||
let subQuery table = $"(SELECT id FROM {table} WHERE web_log_id = @webLogId)"
|
||||
let postSubQuery = subQuery "post"
|
||||
let pageSubQuery = subQuery "page"
|
||||
let! _ =
|
||||
Sql.existingConnection conn
|
||||
|> Sql.query $"""
|
||||
DELETE FROM post_comment WHERE post_id IN {postSubQuery};
|
||||
DELETE FROM post_revision WHERE post_id IN {postSubQuery};
|
||||
DELETE FROM post_category WHERE post_id IN {postSubQuery};
|
||||
DELETE FROM post WHERE web_log_id = @webLogId;
|
||||
DELETE FROM page_revision WHERE page_id IN {pageSubQuery};
|
||||
DELETE FROM page WHERE web_log_id = @webLogId;
|
||||
DELETE FROM category WHERE web_log_id = @webLogId;
|
||||
DELETE FROM tag_map WHERE web_log_id = @webLogId;
|
||||
DELETE FROM upload WHERE web_log_id = @webLogId;
|
||||
DELETE FROM web_log_user WHERE web_log_id = @webLogId;
|
||||
DELETE FROM web_log_feed_podcast WHERE feed_id IN {subQuery "web_log_feed"};
|
||||
DELETE FROM web_log_feed WHERE web_log_id = @webLogId;
|
||||
DELETE FROM web_log WHERE id = @webLogId"""
|
||||
|> Sql.parameters [ webLogIdParam webLogId ]
|
||||
|> Sql.executeNonQueryAsync
|
||||
()
|
||||
}
|
||||
|
||||
/// Find a web log by its host (URL base)
|
||||
let findByHost (url : string) = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM web_log WHERE url_base = @urlBase"
|
||||
cmd.Parameters.AddWithValue ("@urlBase", url) |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
if rdr.Read () then
|
||||
let! webLog = appendCustomFeeds (Map.toWebLog rdr)
|
||||
return Some webLog
|
||||
else
|
||||
return None
|
||||
}
|
||||
|
||||
/// Find a web log by its ID
|
||||
let findById webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM web_log WHERE id = @webLogId"
|
||||
addWebLogId cmd webLogId
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
if rdr.Read () then
|
||||
let! webLog = appendCustomFeeds (Map.toWebLog rdr)
|
||||
return Some webLog
|
||||
else
|
||||
return None
|
||||
}
|
||||
|
||||
/// Update settings for a web log
|
||||
let updateSettings webLog = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- """
|
||||
UPDATE web_log
|
||||
SET name = @name,
|
||||
slug = @slug,
|
||||
subtitle = @subtitle,
|
||||
default_page = @defaultPage,
|
||||
posts_per_page = @postsPerPage,
|
||||
theme_id = @themeId,
|
||||
url_base = @urlBase,
|
||||
time_zone = @timeZone,
|
||||
auto_htmx = @autoHtmx,
|
||||
uploads = @uploads,
|
||||
is_feed_enabled = @isFeedEnabled,
|
||||
feed_name = @feedName,
|
||||
items_in_feed = @itemsInFeed,
|
||||
is_category_enabled = @isCategoryEnabled,
|
||||
is_tag_enabled = @isTagEnabled,
|
||||
copyright = @copyright
|
||||
WHERE id = @id"""
|
||||
addWebLogParameters cmd webLog
|
||||
do! write cmd
|
||||
}
|
||||
|
||||
/// Update RSS options for a web log
|
||||
let updateRssOptions webLog = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- """
|
||||
UPDATE web_log
|
||||
SET is_feed_enabled = @isFeedEnabled,
|
||||
feed_name = @feedName,
|
||||
items_in_feed = @itemsInFeed,
|
||||
is_category_enabled = @isCategoryEnabled,
|
||||
is_tag_enabled = @isTagEnabled,
|
||||
copyright = @copyright
|
||||
WHERE id = @id"""
|
||||
addWebLogRssParameters cmd webLog
|
||||
cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.Id) |> ignore
|
||||
do! write cmd
|
||||
do! updateCustomFeeds webLog
|
||||
}
|
||||
|
||||
interface IWebLogData with
|
||||
member _.Add webLog = add webLog
|
||||
member _.All () = all ()
|
||||
member _.Delete webLogId = delete webLogId
|
||||
member _.FindByHost url = findByHost url
|
||||
member _.FindById webLogId = findById webLogId
|
||||
member _.UpdateSettings webLog = updateSettings webLog
|
||||
member _.UpdateRssOptions webLog = updateRssOptions webLog
|
||||
@ -11,9 +11,14 @@ type PostgreSqlData (conn : NpgsqlConnection, log : ILogger<PostgreSqlData>) =
|
||||
|
||||
interface IData with
|
||||
|
||||
member _.Category = PostgreSqlCategoryData conn
|
||||
member _.Page = PostgreSqlPageData conn
|
||||
member _.Post = PostgreSqlPostData conn
|
||||
member _.Category = PostgreSqlCategoryData conn
|
||||
member _.Page = PostgreSqlPageData conn
|
||||
member _.Post = PostgreSqlPostData conn
|
||||
member _.TagMap = PostgreSqlTagMapData conn
|
||||
member _.Theme = PostgreSqlThemeData conn
|
||||
member _.ThemeAsset = PostgreSqlThemeAssetData conn
|
||||
member _.Upload = PostgreSqlUploadData conn
|
||||
member _.WebLog = PostgreSqlWebLogData conn
|
||||
|
||||
member _.StartUp () = backgroundTask {
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user