V2 #1

Merged
danieljsummers merged 102 commits from v2 into main 2022-06-23 00:35:12 +00:00
Showing only changes of commit 4dcbffbf25 - Show all commits

View File

@ -1,14 +1,15 @@
namespace MyWebLog.Data
open System
open System.IO
open System.Threading.Tasks
open Microsoft.Data.Sqlite
open MyWebLog
open MyWebLog.ViewModels
/// Helper functions for the SQLite data implementation
[<AutoOpen>]
module private SqliteHelpers =
do ()
/// Run a command that returns a count
let count (cmd : SqliteCommand) = backgroundTask {
@ -49,6 +50,12 @@ module private SqliteHelpers =
/// Get a date/time value from a data reader
let getDateTime col (rdr : SqliteDataReader) = rdr.GetDateTime (rdr.GetOrdinal col)
/// Get an int value from a data reader
let getInt col (rdr : SqliteDataReader) = rdr.GetInt32 (rdr.GetOrdinal col)
/// Get a BLOB stream value from a data reader
let getStream col (rdr : SqliteDataReader) = rdr.GetStream (rdr.GetOrdinal col)
/// Get a string value from a data reader
let getString col (rdr : SqliteDataReader) = rdr.GetString (rdr.GetOrdinal col)
@ -56,6 +63,10 @@ module private SqliteHelpers =
let tryDateTime col (rdr : SqliteDataReader) =
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getDateTime col rdr)
/// Get a possibly null int value from a data reader
let tryInt col (rdr : SqliteDataReader) =
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getInt col rdr)
/// Get a possibly null string value from a data reader
let tryString col (rdr : SqliteDataReader) =
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getString col rdr)
@ -73,6 +84,31 @@ module private SqliteHelpers =
parentId = tryString "parent_id" rdr |> Option.map CategoryId
}
/// Create a custom feed from the current row in the given data reader
let toCustomFeed (rdr : SqliteDataReader) : CustomFeed =
{ id = CustomFeedId (getString "id" rdr)
source = CustomFeedSource.parse (getString "source" rdr)
path = Permalink (getString "path" rdr)
podcast =
if rdr.IsDBNull (rdr.GetOrdinal "title") then
None
else
Some {
title = getString "title" rdr
subtitle = tryString "subtitle" rdr
itemsInFeed = getInt "items_in_feed" rdr
summary = getString "summary" rdr
displayedAuthor = getString "displayed_author" rdr
email = getString "email" rdr
imageUrl = Permalink (getString "image_url" rdr)
iTunesCategory = getString "itunes_category" rdr
iTunesSubcategory = tryString "itunes_subcategory" rdr
explicit = ExplicitRating.parse (getString "explicit" rdr)
defaultMediaType = tryString "default_media_type" rdr
mediaBaseUrl = tryString "media_base_url" rdr
}
}
/// Create a meta item from the current row in the given data reader
let toMetaItem (rdr : SqliteDataReader) : MetaItem =
{ name = getString "name" rdr
@ -118,22 +154,69 @@ module private SqliteHelpers =
text = MarkupText.parse (getString "revision_text" rdr)
}
/// Create a tag mapping from the current row in the given data reader
let toTagMap (rdr : SqliteDataReader) : TagMap =
{ id = TagMapId (getString "id" rdr)
webLogId = WebLogId (getString "web_log_id" rdr)
tag = getString "tag" rdr
urlValue = getString "url_value" rdr
}
/// Create a theme from the current row in the given data reader (excludes templates)
let toTheme (rdr : SqliteDataReader) : Theme =
{ Theme.empty with
id = ThemeId (getString "id" rdr)
name = getString "name" rdr
version = getString "version" rdr
}
/// Create a theme asset from the current row in the given data reader
let toThemeAsset includeData (rdr : SqliteDataReader) : ThemeAsset =
let assetData =
if includeData then
use dataStream = new MemoryStream ()
use blobStream = getStream "data" rdr
blobStream.CopyTo dataStream
dataStream.ToArray ()
else
[||]
{ id = ThemeAssetId (ThemeId (getString "id" rdr), getString "path" rdr)
updatedOn = getDateTime "updated_on" rdr
data = assetData
}
/// Create a theme template from the current row in the given data reader
let toThemeTemplate (rdr : SqliteDataReader) : ThemeTemplate =
{ name = getString "name" rdr
text = getString "template" rdr
}
/// Create a web log from the current row in the given data reader
let toWebLog (rdr : SqliteDataReader) : WebLog =
{ id = WebLogId (getString "id" rdr)
name = getString "name" rdr
subtitle = tryString "subtitle" rdr
defaultPage = getString "default_page" rdr
postsPerPage = getInt "posts_per_page" rdr
themePath = getString "theme_id" rdr
urlBase = getString "url_base" rdr
timeZone = getString "time_zone" rdr
autoHtmx = getBoolean "auto_htmx" rdr
rss = {
feedEnabled = getBoolean "feed_enabled" rdr
feedName = getString "feed_name" rdr
itemsInFeed = tryInt "items_in_feed" rdr
categoryEnabled = getBoolean "category_enabled" rdr
tagEnabled = getBoolean "tag_enabled" rdr
copyright = tryString "copyright" rdr
customFeeds = []
}
}
/// SQLite myWebLog data implementation
type SQLiteData (conn : SqliteConnection) =
// /// Shorthand for accessing the collections in the LiteDB database
// let Collection = {|
// Category = db.GetCollection<Category> "Category"
// Comment = db.GetCollection<Comment> "Comment"
// Page = db.GetCollection<Page> "Page"
// Post = db.GetCollection<Post> "Post"
// TagMap = db.GetCollection<TagMap> "TagMap"
// Theme = db.GetCollection<Theme> "Theme"
// ThemeAsset = db.GetCollection<ThemeAsset> "ThemeAsset"
// WebLog = db.GetCollection<WebLog> "WebLog"
// WebLogUser = db.GetCollection<WebLogUser> "WebLogUser"
// |}
/// Add parameters for category INSERT or UPDATE statements
let addCategoryParameters (cmd : SqliteCommand) (cat : Category) =
[ cmd.Parameters.AddWithValue ("@id", CategoryId.toString cat.id)
@ -177,6 +260,33 @@ type SQLiteData (conn : SqliteConnection) =
cmd.Parameters.AddWithValue ("@text", post.text)
] |> ignore
/// Add parameters for web log INSERT or web log/RSS options UPDATE statements
let addWebLogRssParameters (cmd : SqliteCommand) (webLog : WebLog) =
[ cmd.Parameters.AddWithValue ("@feedEnabled", webLog.rss.feedEnabled)
cmd.Parameters.AddWithValue ("@feedName", webLog.rss.feedName)
cmd.Parameters.AddWithValue ("@itemsInFeed",
match webLog.rss.itemsInFeed with Some it -> it :> obj | None -> DBNull.Value)
cmd.Parameters.AddWithValue ("@categoryEnabled", webLog.rss.categoryEnabled)
cmd.Parameters.AddWithValue ("@tagEnabled", webLog.rss.tagEnabled)
cmd.Parameters.AddWithValue ("@copyright",
match webLog.rss.copyright with Some c -> c :> obj | None -> DBNull.Value)
] |> ignore
/// Add parameters for web log INSERT or UPDATE statements
let addWebLogParameters (cmd : SqliteCommand) (webLog : WebLog) =
[ cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.id)
cmd.Parameters.AddWithValue ("@name", webLog.name)
cmd.Parameters.AddWithValue ("@subtitle",
match webLog.subtitle with Some s -> s :> obj | None -> DBNull.Value)
cmd.Parameters.AddWithValue ("@defaultPage", webLog.defaultPage)
cmd.Parameters.AddWithValue ("@postsPerPage", webLog.postsPerPage)
cmd.Parameters.AddWithValue ("@themeId", webLog.themePath)
cmd.Parameters.AddWithValue ("@urlBase", webLog.urlBase)
cmd.Parameters.AddWithValue ("@timeZone", webLog.timeZone)
cmd.Parameters.AddWithValue ("@autoHtmx", webLog.autoHtmx)
] |> ignore
addWebLogRssParameters cmd webLog
/// Add a web log ID parameter
let addWebLogId (cmd : SqliteCommand) webLogId =
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore
@ -333,13 +443,9 @@ type SQLiteData (conn : SqliteConnection) =
return { post with revisions = toList Map.toRevision revRdr }
}
/// Return a post with no revisions or prior permalinks
let postWithoutRevisions (post : Post) =
{ post with revisions = []; priorPermalinks = [] }
/// Return a post with no revisions, prior permalinks, or text
let postWithoutText post =
{ postWithoutRevisions post with text = "" }
let postWithoutText rdr =
{ Map.toPost rdr with text = "" }
/// Update a post's assigned categories
let updatePostCategories postId oldCats newCats = backgroundTask {
@ -473,7 +579,18 @@ type SQLiteData (conn : SqliteConnection) =
|> ignore
}
/// Append custom feeds to a web log
let appendCustomFeeds (webLog : WebLog) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""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"""
addWebLogId cmd webLog.id
use! rdr = cmd.ExecuteReaderAsync ()
return { webLog with rss = { webLog.rss with customFeeds = toList Map.toCustomFeed rdr } }
}
/// The connection for this instance
@ -935,47 +1052,131 @@ type SQLiteData (conn : SqliteConnection) =
return List.ofArray posts
}
member _.findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage =
Collection.Post.Find (fun p ->
p.webLogId = webLogId
&& p.status = Published
&& p.categoryIds |> List.exists (fun cId -> categoryIds |> List.contains cId))
|> Seq.map postWithoutRevisions
|> Seq.sortByDescending (fun p -> p.publishedOn)
|> toPagedList pageNbr postsPerPage
member _.findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""SELECT p.*
FROM post p
INNER JOIN post_category pc ON pc.post_id = p.id
WHERE p.web_log_id = @webLogId
AND p.status = @status
AND pc.category_id IN ("""
categoryIds
|> List.iteri (fun idx catId ->
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
cmd.CommandText <- $"{cmd.CommandText}@catId{idx}"
cmd.Parameters.AddWithValue ($"@catId{idx}", CategoryId.toString catId) |> ignore)
cmd.CommandText <-
$"""{cmd.CommandText})
ORDER BY published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
let! posts =
toList Map.toPost rdr
|> List.map (fun post -> backgroundTask { return! appendPostCategoryTagAndMeta post })
|> Task.WhenAll
return List.ofArray posts
}
member _.findPageOfPosts webLogId pageNbr postsPerPage =
Collection.Post.Find (fun p -> p.webLogId = webLogId)
|> Seq.map postWithoutText
|> Seq.sortByDescending (fun p -> defaultArg p.publishedOn p.updatedOn)
|> toPagedList pageNbr postsPerPage
member _.findPageOfPosts webLogId pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
$"""SELECT p.*
FROM post p
WHERE p.web_log_id = @webLogId
ORDER BY published_on DESC NULLS FIRST, updated_on
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync ()
let! posts =
toList postWithoutText rdr
|> List.map (fun post -> backgroundTask { return! appendPostCategoryTagAndMeta post })
|> Task.WhenAll
return List.ofArray posts
}
member _.findPageOfPublishedPosts webLogId pageNbr postsPerPage =
Collection.Post.Find (fun p -> p.webLogId = webLogId && p.status = Published)
|> Seq.map postWithoutRevisions
|> Seq.sortByDescending (fun p -> p.publishedOn)
|> toPagedList pageNbr postsPerPage
member _.findPageOfPublishedPosts webLogId pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
$"""SELECT p.*
FROM post p
WHERE p.web_log_id = @webLogId
AND p.status = @status
ORDER BY published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
let! posts =
toList Map.toPost rdr
|> List.map (fun post -> backgroundTask { return! appendPostCategoryTagAndMeta post })
|> Task.WhenAll
return List.ofArray posts
}
member _.findPageOfTaggedPosts webLogId tag pageNbr postsPerPage =
Collection.Post.Find (fun p ->
p.webLogId = webLogId && p.status = Published && p.tags |> List.contains tag)
|> Seq.map postWithoutRevisions
|> Seq.sortByDescending (fun p -> p.publishedOn)
|> toPagedList pageNbr postsPerPage
member _.findPageOfTaggedPosts webLogId tag pageNbr postsPerPage = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
$"""SELECT p.*
FROM post p
INNER JOIN post_tag pt ON pt.post_id = p.id
WHERE p.web_log_id = @webLogId
AND p.status = @status
AND pt.tag = @tag
ORDER BY published_on DESC
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published)
cmd.Parameters.AddWithValue ("@tag", tag)
] |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
let! posts =
toList Map.toPost rdr
|> List.map (fun post -> backgroundTask { return! appendPostCategoryTagAndMeta post })
|> Task.WhenAll
return List.ofArray posts
}
member _.findSurroundingPosts webLogId publishedOn = backgroundTask {
let! older =
Collection.Post.Find (fun p ->
p.webLogId = webLogId && p.status = Published && p.publishedOn.Value < publishedOn)
|> Seq.map postWithoutText
|> Seq.sortByDescending (fun p -> p.publishedOn)
|> tryFirst
let! newer =
Collection.Post.Find (fun p ->
p.webLogId = webLogId && p.status = Published && p.publishedOn.Value > publishedOn)
|> Seq.map postWithoutText
|> Seq.sortBy (fun p -> p.publishedOn)
|> tryFirst
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""SELECT *
FROM post
WHERE web_log_id = @webLogId
AND status = @status
AND published_on < @publishedOn
ORDER BY published_on DESC
LIMIT 1"""
addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published)
cmd.Parameters.AddWithValue ("@publishedOn", publishedOn)
] |> ignore
use! oldRdr = cmd.ExecuteReaderAsync ()
let! older = backgroundTask {
if oldRdr.Read () then
let! post = appendPostCategoryTagAndMeta (postWithoutText oldRdr)
return Some post
else
return None
}
cmd.CommandText <-
"""SELECT *
FROM post
WHERE web_log_id = @webLogId
AND status = @status
AND published_on > @publishedOn
ORDER BY published_on
LIMIT 1"""
use! newRdr = cmd.ExecuteReaderAsync ()
let! newer = backgroundTask {
if newRdr.Read () then
let! post = appendPostCategoryTagAndMeta (postWithoutText oldRdr)
return Some post
else
return None
}
return older, newer
}
@ -1022,55 +1223,108 @@ type SQLiteData (conn : SqliteConnection) =
member _.TagMap = {
new ITagMapData with
member _.findById tagMapId webLogId =
Collection.TagMap.FindById (TagMapIdMapping.toBson tagMapId)
//|> verifyWebLog webLogId (fun tm -> tm.webLogId)
member _.findById tagMapId webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM tag_map WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMapId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return verifyWebLog<TagMap> webLogId (fun tm -> tm.webLogId) Map.toTagMap rdr
}
member this.delete tagMapId webLogId = backgroundTask {
match! this.findById tagMapId webLogId with
| Some _ ->
let _ = Collection.TagMap.Delete (TagMapIdMapping.toBson tagMapId)
do! checkpoint ()
use cmd = conn.CreateCommand ()
cmd.CommandText <- "DELETE FROM tag_map WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMapId) |> ignore
do! write cmd
return true
| None -> return false
}
member _.findByUrlValue urlValue webLogId =
Collection.TagMap.Find (fun tm -> tm.webLogId = webLogId && tm.urlValue = urlValue)
|> tryFirst
member _.findByWebLog webLogId =
Collection.TagMap.Find (fun tm -> tm.webLogId = webLogId)
|> Seq.sortBy (fun tm -> tm.tag)
|> toList
member _.findMappingForTags tags webLogId =
Collection.TagMap.Find (fun tm -> tm.webLogId = webLogId && tags |> List.contains tm.tag)
|> toList
member _.restore tagMaps = backgroundTask {
let _ = Collection.TagMap.InsertBulk tagMaps
do! checkpoint ()
member _.findByUrlValue urlValue webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM tag_map WHERE web_log_id = @webLogId AND url_value = @urlValue"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@urlValue", urlValue) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return if rdr.Read () then Some (Map.toTagMap rdr) else None
}
member _.save tagMap = backgroundTask {
let _ = Collection.TagMap.Upsert tagMap
do! checkpoint ()
member _.findByWebLog webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM tag_map WHERE web_log_id = @webLogId ORDER BY tag"
addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync ()
return toList Map.toTagMap rdr
}
member _.findMappingForTags tags webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""SELECT *
FROM tag_map
WHERE web_log_id = @webLogId
AND tag IN ("""
tags
|> List.iteri (fun idx tag ->
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
cmd.CommandText <- $"{cmd.CommandText}@tag{idx}"
cmd.Parameters.AddWithValue ($"@tag{idx}", tag) |> ignore)
cmd.CommandText <- $"{cmd.CommandText})"
addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync ()
return toList Map.toTagMap rdr
}
member this.save tagMap = backgroundTask {
use cmd = conn.CreateCommand ()
match! this.findById tagMap.id tagMap.webLogId with
| Some _ ->
cmd.CommandText <-
"""UPDATE tag_map
SET tag = @tag,
url_value = @urlValue
WHERE id = @id
AND web_log_id = @webLogId"""
| None -> cmd.CommandText <- "INSERT INTO tag_map VALUES (@id, @webLogId, @tag, @urlValue)"
addWebLogId cmd tagMap.webLogId
[ cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMap.id)
cmd.Parameters.AddWithValue ("@tag", tagMap.tag)
cmd.Parameters.AddWithValue ("@urlValue", tagMap.urlValue)
] |> ignore
do! write cmd
}
member this.restore tagMaps = backgroundTask {
for tagMap in tagMaps do
do! this.save tagMap
}
}
member _.Theme = {
new IThemeData with
member _.all () =
Collection.Theme.Find (fun t -> t.id <> ThemeId "admin")
|> Seq.map (fun t -> { t with templates = [] })
|> Seq.sortBy (fun t -> t.id)
|> toList
member _.all () = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM theme WHERE id <> 'admin' ORDER BY id"
use! rdr = cmd.ExecuteReaderAsync ()
return toList Map.toTheme rdr
}
member _.findById themeId =
Collection.Theme.FindById (ThemeIdMapping.toBson themeId)
|> toOption
member _.findById themeId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM theme WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", ThemeId.toString themeId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
if rdr.Read () then
let theme = Map.toTheme rdr
cmd.CommandText <- "SELECT * FROM theme_template WHERE theme_id = @id"
use! templateRdr = cmd.ExecuteReaderAsync ()
return Some { theme with templates = toList Map.toThemeTemplate templateRdr }
else
return None
}
member this.findByIdWithoutText themeId = backgroundTask {
match! this.findById themeId with
@ -1081,47 +1335,143 @@ type SQLiteData (conn : SqliteConnection) =
| None -> return None
}
member _.save theme = backgroundTask {
let _ = Collection.Theme.Upsert theme
do! checkpoint ()
member this.save theme = backgroundTask {
use cmd = conn.CreateCommand ()
let! oldTheme = this.findById theme.id
cmd.CommandText <-
match oldTheme with
| Some _ -> "UPDATE theme SET name = @name, version = @version WHERE id = @id"
| None -> "INSERT INTO theme (@id, @name, @version)"
[ cmd.Parameters.AddWithValue ("@id", ThemeId.toString theme.id)
cmd.Parameters.AddWithValue ("@name", theme.name)
cmd.Parameters.AddWithValue ("@version", theme.version)
] |> ignore
do! write cmd
let toDelete, toAdd =
diffLists (oldTheme |> Option.map (fun t -> t.templates) |> Option.defaultValue [])
theme.templates (fun t -> t.name)
let toUpdate =
theme.templates
|> List.filter (fun t ->
not (toDelete |> List.exists (fun d -> d.name = t.name))
&& not (toAdd |> List.exists (fun a -> a.name = t.name)))
cmd.CommandText <-
"UPDATE theme_template SET template = @template WHERE theme_id = @themeId AND name = @name"
toUpdate
|> List.map (fun template -> backgroundTask {
cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString theme.id)
cmd.Parameters.AddWithValue ("@name", template.name)
cmd.Parameters.AddWithValue ("@template", template.text)
] |> ignore
do! write cmd
})
|> Task.WhenAll
|> ignore
cmd.CommandText <- "INSERT INTO theme_template (@themeId, @name, @template)"
toAdd
|> List.map (fun template -> backgroundTask {
cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString theme.id)
cmd.Parameters.AddWithValue ("@name", template.name)
cmd.Parameters.AddWithValue ("@template", template.text)
] |> ignore
do! write cmd
})
|> Task.WhenAll
|> ignore
cmd.CommandText <- "DELETE FROM theme_template WHERE theme_id = @themeId AND name = @name"
toDelete
|> List.map (fun template -> backgroundTask {
cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString theme.id)
cmd.Parameters.AddWithValue ("@name", template.name)
] |> ignore
do! write cmd
})
|> Task.WhenAll
|> ignore
}
}
member _.ThemeAsset = {
new IThemeAssetData with
member _.all () =
Collection.ThemeAsset.FindAll ()
|> Seq.map (fun ta -> { ta with data = [||] })
|> toList
member _.deleteByTheme themeId = backgroundTask {
(ThemeId.toString
>> sprintf "$.id LIKE '%s%%'"
>> BsonExpression.Create
>> Collection.ThemeAsset.DeleteMany) themeId
|> ignore
do! checkpoint ()
member _.all () = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT theme_id, path, updated_on FROM theme_asset"
use! rdr = cmd.ExecuteReaderAsync ()
return toList (Map.toThemeAsset false) rdr
}
member _.findById assetId =
Collection.ThemeAsset.FindById (ThemeAssetIdMapping.toBson assetId)
|> toOption
member _.deleteByTheme themeId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "DELETE FROM theme_asset WHERE theme_id = @themeId"
cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString themeId) |> ignore
do! write cmd
}
member _.findByTheme themeId =
Collection.ThemeAsset.Find (fun ta ->
(ThemeAssetId.toString ta.id).StartsWith (ThemeId.toString themeId))
|> Seq.map (fun ta -> { ta with data = [||] })
|> toList
member _.findById assetId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT *, ROWID FROM theme_asset WHERE theme_id = @themeId AND path = @path"
let (ThemeAssetId (ThemeId themeId, path)) = assetId
[ cmd.Parameters.AddWithValue ("@themeId", themeId)
cmd.Parameters.AddWithValue ("@path", path)
] |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return if rdr.Read () then Some (Map.toThemeAsset true rdr) else None
}
member _.findByThemeWithData themeId =
Collection.ThemeAsset.Find (fun ta ->
(ThemeAssetId.toString ta.id).StartsWith (ThemeId.toString themeId))
|> toList
member _.findByTheme themeId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT theme_id, path, updated_on FROM theme_asset WHERE theme_id = @themeId"
cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString themeId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return toList (Map.toThemeAsset false) rdr
}
member _.findByThemeWithData themeId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT *, ROWID FROM theme_asset WHERE theme_id = @themeId"
cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString themeId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return toList (Map.toThemeAsset true) rdr
}
member _.save asset = backgroundTask {
let _ = Collection.ThemeAsset.Upsert asset
do! checkpoint ()
use sideCmd = conn.CreateCommand ()
sideCmd.CommandText <-
"SELECT COUNT(path) FROM theme_asset WHERE theme_id = @themeId AND path = @path"
let (ThemeAssetId (ThemeId themeId, path)) = asset.id
[ sideCmd.Parameters.AddWithValue ("@themeId", themeId)
sideCmd.Parameters.AddWithValue ("@path", path)
] |> ignore
let! exists = count sideCmd
use cmd = conn.CreateCommand ()
cmd.CommandText <-
if exists = 1 then
"""UPDATE theme_asset
SET updated_on = @updatedOn,
data = ZEROBLOB(@dataLength)
WHERE theme_id = @themeId
AND path = @path"""
else
"INSERT INTO theme_asset VALUES (@themeId, @path, @updatedOn, ZEROBLOB(@dataLength))"
[ cmd.Parameters.AddWithValue ("@themeId", themeId)
cmd.Parameters.AddWithValue ("@path", path)
cmd.Parameters.AddWithValue ("@updatedOn", asset.updatedOn)
cmd.Parameters.AddWithValue ("@dataLength", asset.data.Length)
] |> ignore
do! write cmd
sideCmd.CommandText <- "SELECT ROWID FROM theme_asset WHERE theme_id = @themeId AND path = @path"
let! rowId = sideCmd.ExecuteScalarAsync ()
use dataStream = new MemoryStream (asset.data)
use blobStream = new SqliteBlob (conn, "theme_asset", "data", rowId :?> int64)
do! dataStream.CopyToAsync blobStream
}
}
@ -1129,43 +1479,117 @@ type SQLiteData (conn : SqliteConnection) =
new IWebLogData with
member _.add webLog = backgroundTask {
let _ = Collection.WebLog.Insert webLog
do! checkpoint ()
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""INSERT INTO web_log
VALUES (@id, @name, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone,
@autoHtmx, @feedEnabled, @feedName, @itemsInFeed, @categoryEnabled, @tagEnabled,
@copyright)"""
addWebLogParameters cmd webLog
do! write cmd
}
member _.all () =
Collection.WebLog.FindAll ()
|> toList
member _.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
}
member _.delete webLogId = backgroundTask {
let forWebLog = BsonExpression.Create $"$.webLogId = '{WebLogId.toString webLogId}'"
let _ = Collection.Comment.DeleteMany forWebLog
let _ = Collection.Post.DeleteMany forWebLog
let _ = Collection.Page.DeleteMany forWebLog
let _ = Collection.Category.DeleteMany forWebLog
let _ = Collection.TagMap.DeleteMany forWebLog
let _ = Collection.WebLogUser.DeleteMany forWebLog
let _ = Collection.WebLog.Delete (WebLogIdMapping.toBson webLogId)
do! checkpoint ()
use cmd = conn.CreateCommand ()
addWebLogId cmd webLogId
let subQuery table = $"(SELECT id FROM {table} WHERE web_log_id = @webLogId)"
let postSubQuery = subQuery "post"
let pageSubQuery = subQuery "page"
[ $"DELETE FROM post_comment WHERE post_id IN {postSubQuery}"
$"DELETE FROM post_revision WHERE post_id IN {postSubQuery}"
$"DELETE FROM post_tag WHERE post_id IN {postSubQuery}"
$"DELETE FROM post_category WHERE post_id IN {postSubQuery}"
$"DELETE FROM post_meta 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_meta 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 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"
]
|> List.map (fun query -> backgroundTask {
cmd.CommandText <- query
do! write cmd
})
|> Task.WhenAll
|> ignore
}
member _.findByHost url =
Collection.WebLog.Find (fun wl -> wl.urlBase = url)
|> tryFirst
member _.findByHost url = 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
}
member _.findById webLogId =
Collection.WebLog.FindById (WebLogIdMapping.toBson webLogId)
|> toOption
member _.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
}
member _.updateSettings webLog = backgroundTask {
let _ = Collection.WebLog.Update webLog
do! checkpoint ()
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""UPDATE web_log
SET name = @name,
subtitle = @subtitle,
default_page = @defaultPage,
posts_per_page = @postsPerPage,
theme_id = @themeId,
url_base = @urlBase,
time_zone = @timeZone,
auto_htmx = @autoHtmx,
feed_enabled = @feedEnabled,
feed_name = @feedName
items_in_feed = @itemsInFeed,
category_enabled = @categoryEnabled,
tag_enabled = @tagEnabled,
copyright = @copyright
WHERE id = @id"""
addWebLogParameters cmd webLog
do! write cmd
}
member this.updateRssOptions webLog = backgroundTask {
match! this.findById webLog.id with
| Some wl -> do! this.updateSettings { wl with rss = webLog.rss }
| None -> ()
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""UPDATE web_log
SET feed_enabled = @feedEnabled,
feed_name = @feedName
items_in_feed = @itemsInFeed,
category_enabled = @categoryEnabled,
tag_enabled = @tagEnabled,
copyright = @copyright
WHERE id = @id"""
addWebLogRssParameters cmd webLog
do! write cmd
}
}
@ -1236,7 +1660,7 @@ type SQLiteData (conn : SqliteConnection) =
theme_id TEXT NOT NULL REFERENCES theme (id),
path TEXT NOT NULL,
updated_on TEXT NOT NULL,
data BINARY NOT NULL,
data BLOB NOT NULL,
PRIMARY KEY (theme_id, path))"""
do! write cmd
@ -1245,18 +1669,14 @@ type SQLiteData (conn : SqliteConnection) =
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""CREATE TABLE web_log (
id TEXT PRIMARY KEY,
name TEXT NOT NULL,
subtitle TEXT,
default_page TEXT NOT NULL,
theme_id TEXT NOT NULL REFERENCES theme (id),
url_base TEXT NOT NULL,
time_zone TEXT NOT NULL,
auto_htmx INTEGER NOT NULL DEFAULT 0)"""
do! write cmd
cmd.CommandText <-
"""CREATE TABLE web_log_rss (
web_log_id TEXT PRIMARY KEY REFERENCES web_log (id),
id TEXT PRIMARY KEY,
name TEXT NOT NULL,
subtitle TEXT,
default_page TEXT NOT NULL,
theme_id TEXT NOT NULL REFERENCES theme (id),
url_base TEXT NOT NULL,
time_zone TEXT NOT NULL,
auto_htmx INTEGER NOT NULL DEFAULT 0,
feed_enabled INTEGER NOT NULL DEFAULT 0,
feed_name TEXT NOT NULL,
items_in_feed INTEGER,