diff --git a/src/MyWebLog.Data/MyWebLog.Data.fsproj b/src/MyWebLog.Data/MyWebLog.Data.fsproj
index 090e70e..4b2d394 100644
--- a/src/MyWebLog.Data/MyWebLog.Data.fsproj
+++ b/src/MyWebLog.Data/MyWebLog.Data.fsproj
@@ -36,6 +36,9 @@
+
+
+
diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlCategoryData.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlCategoryData.fs
index e0d7c9c..92ffa36 100644
--- a/src/MyWebLog.Data/PostgreSql/PostgreSqlCategoryData.fs
+++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlCategoryData.fs
@@ -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
diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlHelpers.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlHelpers.fs
index 8004f45..ed20a1e 100644
--- a/src/MyWebLog.Data/PostgreSql/PostgreSqlHelpers.fs
+++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlHelpers.fs
@@ -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 = []
+ }
+ }
+
diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlPageData.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlPageData.fs
index 0fd42ee..826dc4b 100644
--- a/src/MyWebLog.Data/PostgreSql/PostgreSqlPageData.fs
+++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlPageData.fs
@@ -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
diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlPostData.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlPostData.fs
index 4679ab9..1d4da91 100644
--- a/src/MyWebLog.Data/PostgreSql/PostgreSqlPostData.fs
+++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlPostData.fs
@@ -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
diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlTagMapData.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlTagMapData.fs
index 52e9cb6..4287086 100644
--- a/src/MyWebLog.Data/PostgreSql/PostgreSqlTagMapData.fs
+++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlTagMapData.fs
@@ -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
diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlThemeData.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlThemeData.fs
new file mode 100644
index 0000000..35f5501
--- /dev/null
+++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlThemeData.fs
@@ -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
diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlUploadData.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlUploadData.fs
new file mode 100644
index 0000000..b509f02
--- /dev/null
+++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlUploadData.fs
@@ -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
+
\ No newline at end of file
diff --git a/src/MyWebLog.Data/PostgreSql/PostgreSqlWebLogData.fs b/src/MyWebLog.Data/PostgreSql/PostgreSqlWebLogData.fs
new file mode 100644
index 0000000..2f298f4
--- /dev/null
+++ b/src/MyWebLog.Data/PostgreSql/PostgreSqlWebLogData.fs
@@ -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
diff --git a/src/MyWebLog.Data/PostgreSqlData.fs b/src/MyWebLog.Data/PostgreSqlData.fs
index a121728..9ed7dfc 100644
--- a/src/MyWebLog.Data/PostgreSqlData.fs
+++ b/src/MyWebLog.Data/PostgreSqlData.fs
@@ -11,9 +11,14 @@ type PostgreSqlData (conn : NpgsqlConnection, log : ILogger) =
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 {