WIP on SQLite data

- Finish pages
- WIP on posts
- Flip data reader function parameter order
This commit is contained in:
Daniel J. Summers 2022-06-18 17:29:35 -04:00
parent 2fc2714287
commit 409019333b
3 changed files with 549 additions and 120 deletions

View File

@ -42,7 +42,7 @@ type IPageData =
/// Add a page
abstract member add : Page -> Task<unit>
/// Get all pages for the web log (excluding text, revisions, and prior permalinks)
/// Get all pages for the web log (excluding meta items, text, revisions, and prior permalinks)
abstract member all : WebLogId -> Task<Page list>
/// Count all pages for the given web log
@ -72,7 +72,7 @@ type IPageData =
/// Find pages marked as "show in page list" for the given web log (excluding text, revisions, and prior permalinks)
abstract member findListed : WebLogId -> Task<Page list>
/// Find a page of pages (displayed in admin section) (excluding revisions and prior permalinks)
/// Find a page of pages (displayed in admin section) (excluding meta items, revisions and prior permalinks)
abstract member findPageOfPages : WebLogId -> pageNbr : int -> Task<Page list>
/// Restore pages from a backup

View File

@ -280,7 +280,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.all webLogId = rethink<Page list> {
withTable Table.Page
getAll [ webLogId ] (nameof webLogId)
without [ "text"; "revisions"; "priorPermalinks" ]
without [ "text"; "metadata"; "revisions"; "priorPermalinks" ]
orderByFunc (fun row -> row["title"].Downcase () :> obj)
result; withRetryDefault conn
}
@ -370,7 +370,7 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
member _.findPageOfPages webLogId pageNbr = rethink<Page list> {
withTable Table.Page
getAll [ webLogId ] (nameof webLogId)
without [ "priorPermalinks"; "revisions" ]
without [ "metadata"; "priorPermalinks"; "revisions" ]
orderByFunc (fun row -> row["title"].Downcase ())
skip ((pageNbr - 1) * 25)
limit 25

View File

@ -16,6 +16,11 @@ module private SqliteHelpers =
return it :?> int
}
/// Get lists of items removed from and added to the given lists
let diffLists<'T, 'U when 'U : equality> oldItems newItems (f : 'T -> 'U) =
let diff compList = fun item -> not (compList |> List.exists (fun other -> f item = f other))
List.filter (diff newItems) oldItems, List.filter (diff oldItems) newItems
/// Create a list of items from the given data reader
let toList<'T> (it : SqliteDataReader -> 'T) (rdr : SqliteDataReader) =
seq { while rdr.Read () do it rdr }
@ -39,57 +44,78 @@ module private SqliteHelpers =
module Map =
/// Get a boolean value from a data reader
let getBoolean (rdr : SqliteDataReader) col = rdr.GetBoolean (rdr.GetOrdinal col)
let getBoolean col (rdr : SqliteDataReader) = rdr.GetBoolean (rdr.GetOrdinal col)
/// Get a date/time value from a data reader
let getDateTime (rdr : SqliteDataReader) col = rdr.GetDateTime (rdr.GetOrdinal col)
let getDateTime col (rdr : SqliteDataReader) = rdr.GetDateTime (rdr.GetOrdinal col)
/// Get a string value from a data reader
let getString (rdr : SqliteDataReader) col = rdr.GetString (rdr.GetOrdinal col)
let getString col (rdr : SqliteDataReader) = rdr.GetString (rdr.GetOrdinal col)
/// Get a possibly null date/time value from a data reader
let tryDateTime col (rdr : SqliteDataReader) =
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getDateTime col rdr)
/// Get a possibly null string value from a data reader
let tryString (rdr : SqliteDataReader) col =
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getString rdr col)
let tryString col (rdr : SqliteDataReader) =
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getString col rdr)
/// Create a category ID from the current row in the given data reader
let toCategoryId = getString "id" >> CategoryId
/// Create a category from the current row in the given data reader
let toCategory (rdr : SqliteDataReader) : Category =
{ id = CategoryId (getString rdr "id")
webLogId = WebLogId (getString rdr "web_log_id")
name = getString rdr "name"
slug = getString rdr "slug"
description = tryString rdr "description"
parentId = tryString rdr "parent_id" |> Option.map CategoryId
{ id = toCategoryId rdr
webLogId = WebLogId (getString "web_log_id" rdr)
name = getString "name" rdr
slug = getString "slug" rdr
description = tryString "description" rdr
parentId = tryString "parent_id" rdr |> Option.map CategoryId
}
/// Create a meta item from the current row in the given data reader
let toMetaItem (rdr : SqliteDataReader) : MetaItem =
{ name = getString rdr "name"
value = getString rdr "value"
{ name = getString "name" rdr
value = getString "value" rdr
}
/// Create a permalink from the current row in the given data reader
let toPermalink (rdr : SqliteDataReader) : Permalink =
Permalink (getString rdr "permalink")
let toPermalink = getString "permalink" >> Permalink
/// Create a page from the current row in the given data reader
let toPage (rdr : SqliteDataReader) : Page =
{ Page.empty with
id = PageId (getString rdr "id")
webLogId = WebLogId (getString rdr "web_log_id")
authorId = WebLogUserId (getString rdr "author_id")
title = getString rdr "title"
id = PageId (getString "id" rdr)
webLogId = WebLogId (getString "web_log_id" rdr)
authorId = WebLogUserId (getString "author_id" rdr)
title = getString "title" rdr
permalink = toPermalink rdr
publishedOn = getDateTime rdr "published_on"
updatedOn = getDateTime rdr "updated_on"
showInPageList = getBoolean rdr "show_in_page_list"
template = tryString rdr "template"
text = getString rdr "page_text"
publishedOn = getDateTime "published_on" rdr
updatedOn = getDateTime "updated_on" rdr
showInPageList = getBoolean "show_in_page_list" rdr
template = tryString "template" rdr
text = getString "page_text" rdr
}
/// Create a post from the current row in the given data reader
let toPost (rdr : SqliteDataReader) : Post =
{ Post.empty with
id = PostId (getString "id" rdr)
webLogId = WebLogId (getString "web_log_id" rdr)
authorId = WebLogUserId (getString "author_id" rdr)
status = PostStatus.parse (getString "status" rdr)
title = getString "title" rdr
permalink = toPermalink rdr
publishedOn = tryDateTime "published_on" rdr
updatedOn = getDateTime "updated_on" rdr
template = tryString "template" rdr
text = getString "page_text" rdr
}
/// Create a revision from the current row in the given data reader
let toRevision (rdr : SqliteDataReader) : Revision =
{ asOf = getDateTime rdr "as_of"
text = MarkupText.parse (getString rdr "revision_text")
{ asOf = getDateTime "as_of" rdr
text = MarkupText.parse (getString "revision_text" rdr)
}
@ -135,29 +161,177 @@ type SQLiteData (conn : SqliteConnection) =
cmd.Parameters.AddWithValue ("@text", page.text)
] |> ignore
/// Add parameters for post INSERT or UPDATE statements
let addPostParameters (cmd : SqliteCommand) (post : Post) =
[ cmd.Parameters.AddWithValue ("@id", PostId.toString post.id)
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString post.webLogId)
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString post.authorId)
cmd.Parameters.AddWithValue ("@status", PostStatus.toString post.status)
cmd.Parameters.AddWithValue ("@title", post.title)
cmd.Parameters.AddWithValue ("@permalink", Permalink.toString post.permalink)
cmd.Parameters.AddWithValue ("@publishedOn",
match post.publishedOn with Some p -> p :> obj | None -> DBNull.Value)
cmd.Parameters.AddWithValue ("@updatedOn", post.updatedOn)
cmd.Parameters.AddWithValue ("@template",
match post.template with Some t -> t :> obj | None -> DBNull.Value)
cmd.Parameters.AddWithValue ("@text", post.text)
] |> ignore
/// Add a web log ID parameter
let addWebLogId (cmd : SqliteCommand) webLogId =
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore
// -- PAGE STUFF --
/// Append meta items to a page
let appendPageMeta (page : Page) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT name, value FROM page_meta WHERE page_id = @id"
cmd.Parameters.AddWithValue ("@id", PageId.toString page.id) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return { page with metadata = toList Map.toMetaItem rdr }
}
/// Return a page with no revisions or prior permalinks
let pageWithoutRevisions (page : Page) =
{ page with revisions = []; priorPermalinks = [] }
/// Append revisions and permalinks to a page
let appendPageRevisionsAndPermalinks (page : Page) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT permalink FROM page_permalink WHERE page_id = @pageId"
cmd.Parameters.AddWithValue ("@pageId", PageId.toString page.id) |> ignore
use! linkRdr = cmd.ExecuteReaderAsync ()
let page = { page with priorPermalinks = toList Map.toPermalink linkRdr }
/// Return a page with no revisions, prior permalinks, or text
let pageWithoutText page =
{ pageWithoutRevisions page with text = "" }
cmd.CommandText <- "SELECT as_of, revision_text FROM page_revision WHERE page_id = @pageId ORDER BY as_of DESC"
use! revRdr = cmd.ExecuteReaderAsync ()
return { page with revisions = toList Map.toRevision revRdr }
}
/// Sort function for pages
let pageSort (page : Page) =
page.title.ToLowerInvariant ()
/// Return a page with no text (or meta items, prior permalinks, or revisions)
let pageWithoutTextOrMeta rdr =
{ Map.toPage rdr with text = "" }
/// Find meta items added and removed
let diffMetaItems (oldItems : MetaItem list) newItems =
diffLists oldItems newItems (fun item -> $"{item.name}|{item.value}")
/// Find the permalinks added and removed
let diffPermalinks oldLinks newLinks =
diffLists oldLinks newLinks Permalink.toString
/// Find the revisions added and removed
let diffRevisions oldRevs newRevs =
diffLists oldRevs newRevs (fun (rev : Revision) -> $"{rev.asOf.Ticks}|{MarkupText.toString rev.text}")
/// Update a page's metadata items
let updatePageMeta pageId oldItems newItems = backgroundTask {
let toDelete, toAdd = diffMetaItems oldItems newItems
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
let runCmd (item : MetaItem) = backgroundTask {
cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId)
cmd.Parameters.AddWithValue ("@name", item.name)
cmd.Parameters.AddWithValue ("@value", item.value)
] |> ignore
do! write cmd
}
cmd.CommandText <- "DELETE FROM page_meta WHERE page_id = @pageId AND name = @name AND value = @value"
toDelete
|> List.map runCmd
|> Task.WhenAll
|> ignore
cmd.CommandText <- "INSERT INTO page_meta VALUES (@pageId, @name, @value)"
toAdd
|> List.map runCmd
|> Task.WhenAll
|> ignore
}
/// Update a page's prior permalinks
let updatePagePermalinks pageId oldLinks newLinks = backgroundTask {
let toDelete, toAdd = diffPermalinks oldLinks newLinks
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
let runCmd link = backgroundTask {
cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId)
cmd.Parameters.AddWithValue ("@link", Permalink.toString link)
] |> ignore
do! write cmd
}
cmd.CommandText <- "DELETE FROM page_permalink WHERE page_id = @pageId AND permalink = @link"
toDelete
|> List.map runCmd
|> Task.WhenAll
|> ignore
cmd.CommandText <- "INSERT INTO page_permalink VALUES (@pageId, @link)"
toAdd
|> List.map runCmd
|> Task.WhenAll
|> ignore
}
/// Update a page's revisions
let updatePageRevisions pageId oldRevs newRevs = backgroundTask {
let toDelete, toAdd = diffRevisions oldRevs newRevs
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
let runCmd withText rev = backgroundTask {
cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId)
cmd.Parameters.AddWithValue ("@asOf", rev.asOf)
] |> ignore
if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.text) |> ignore
do! write cmd
}
cmd.CommandText <- "DELETE FROM page_revision WHERE page_id = @pageId AND as_of = @asOf"
toDelete
|> List.map (runCmd false)
|> Task.WhenAll
|> ignore
cmd.CommandText <- "INSERT INTO page_revision VALUES (@pageId, @asOf, @text)"
toAdd
|> List.map (runCmd true)
|> Task.WhenAll
|> ignore
}
// -- POST STUFF --
/// Append category IDs, tags, and meta items to a post
let appendPostCategoryTagAndMeta (post : Post) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT category_id AS id FROM post_category WHERE post_id = @id"
cmd.Parameters.AddWithValue ("@id", PostId.toString post.id) |> ignore
use! catRdr = cmd.ExecuteReaderAsync ()
let post = { post with categoryIds = toList Map.toCategoryId catRdr }
cmd.CommandText <- "SELECT tag FROM post_tag WHERE post_id = @id"
use! tagRdr = cmd.ExecuteReaderAsync ()
let post = { post with tags = toList (Map.getString "tag") tagRdr }
cmd.CommandText <- "SELECT name, value FROM post_meta WHERE post_id = @id"
use! rdr = cmd.ExecuteReaderAsync ()
return { post with metadata = toList Map.toMetaItem rdr }
}
/// Append revisions and permalinks to a post
let appendPostRevisionsAndPermalinks (post : Post) = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT permalink FROM post_permalink WHERE post_id = @postId"
cmd.Parameters.AddWithValue ("@postId", PostId.toString post.id) |> ignore
use! linkRdr = cmd.ExecuteReaderAsync ()
let post = { post with priorPermalinks = toList Map.toPermalink linkRdr }
cmd.CommandText <- "SELECT as_of, revision_text FROM post_revision WHERE post_id = @postId ORDER BY as_of DESC"
use! revRdr = cmd.ExecuteReaderAsync ()
return { post with revisions = toList Map.toRevision revRdr }
}
/// Return a post with no revisions or prior permalinks
let postWithoutRevisions (post : Post) =
@ -167,6 +341,139 @@ type SQLiteData (conn : SqliteConnection) =
let postWithoutText post =
{ postWithoutRevisions post with text = "" }
/// Update a post's assigned categories
let updatePostCategories postId oldCats newCats = backgroundTask {
let toDelete, toAdd = diffLists oldCats newCats CategoryId.toString
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
let runCmd catId = backgroundTask {
cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
cmd.Parameters.AddWithValue ("@categoryId", CategoryId.toString catId)
] |> ignore
do! write cmd
}
cmd.CommandText <- "DELETE FROM post_category WHERE post_id = @postId AND category_id = @categoryId"
toDelete
|> List.map runCmd
|> Task.WhenAll
|> ignore
cmd.CommandText <- "INSERT INTO post_category VALUES (@postId, @categoryId)"
toAdd
|> List.map runCmd
|> Task.WhenAll
|> ignore
}
/// Update a post's assigned categories
let updatePostTags postId oldTags newTags = backgroundTask {
let toDelete, toAdd = diffLists oldTags newTags id
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
let runCmd tag = backgroundTask {
cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
cmd.Parameters.AddWithValue ("@tag", tag)
] |> ignore
do! write cmd
}
cmd.CommandText <- "DELETE FROM post_tag WHERE post_id = @postId AND tag = @tag"
toDelete
|> List.map runCmd
|> Task.WhenAll
|> ignore
cmd.CommandText <- "INSERT INTO post_tag VALUES (@postId, @tag)"
toAdd
|> List.map runCmd
|> Task.WhenAll
|> ignore
}
/// Update a post's metadata items
let updatePostMeta postId oldItems newItems = backgroundTask {
let toDelete, toAdd = diffMetaItems oldItems newItems
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
let runCmd (item : MetaItem) = backgroundTask {
cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
cmd.Parameters.AddWithValue ("@name", item.name)
cmd.Parameters.AddWithValue ("@value", item.value)
] |> ignore
do! write cmd
}
cmd.CommandText <- "DELETE FROM post_meta WHERE post_id = @postId AND name = @name AND value = @value"
toDelete
|> List.map runCmd
|> Task.WhenAll
|> ignore
cmd.CommandText <- "INSERT INTO post_meta VALUES (@postId, @name, @value)"
toAdd
|> List.map runCmd
|> Task.WhenAll
|> ignore
}
/// Update a post's prior permalinks
let updatePostPermalinks postId oldLinks newLinks = backgroundTask {
let toDelete, toAdd = diffPermalinks oldLinks newLinks
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
let runCmd link = backgroundTask {
cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
cmd.Parameters.AddWithValue ("@link", Permalink.toString link)
] |> ignore
do! write cmd
}
cmd.CommandText <- "DELETE FROM post_permalink WHERE post_id = @postId AND permalink = @link"
toDelete
|> List.map runCmd
|> Task.WhenAll
|> ignore
cmd.CommandText <- "INSERT INTO post_permalink VALUES (@postId, @link)"
toAdd
|> List.map runCmd
|> Task.WhenAll
|> ignore
}
/// Update a post's revisions
let updatePostRevisions postId oldRevs newRevs = backgroundTask {
let toDelete, toAdd = diffRevisions oldRevs newRevs
if List.isEmpty toDelete && List.isEmpty toAdd then
return ()
else
use cmd = conn.CreateCommand ()
let runCmd withText rev = backgroundTask {
cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
cmd.Parameters.AddWithValue ("@asOf", rev.asOf)
] |> ignore
if withText then cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.text) |> ignore
do! write cmd
}
cmd.CommandText <- "DELETE FROM post_revision WHERE post_id = @postId AND as_of = @asOf"
toDelete
|> List.map (runCmd false)
|> Task.WhenAll
|> ignore
cmd.CommandText <- "INSERT INTO post_revision VALUES (@postId, @asOf, @text)"
toAdd
|> List.map (runCmd true)
|> Task.WhenAll
|> ignore
}
/// The connection for this instance
@ -327,33 +634,17 @@ type SQLiteData (conn : SqliteConnection) =
@showInPageList, @template, @text)"""
addPageParameters cmd page
do! write cmd
// Metadata
cmd.CommandText <- "INSERT INTO page_meta VALUES (@pageId, @name, @value)"
for meta in page.metadata do
cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@pageId", PageId.toString page.id)
cmd.Parameters.AddWithValue ("@name", meta.name)
cmd.Parameters.AddWithValue ("@value", meta.value)
] |> ignore
do! write cmd
// Revisions
cmd.CommandText <- "INSERT INTO page_revision VALUES (@pageId, @asOf, @text)"
for rev in page.revisions do
cmd.Parameters.Clear ()
[ cmd.Parameters.AddWithValue ("@pageId", PageId.toString page.id)
cmd.Parameters.AddWithValue ("@asOf", rev.asOf)
cmd.Parameters.AddWithValue ("@text", MarkupText.toString rev.text)
] |> ignore
do! write cmd
do! updatePageMeta page.id [] page.metadata
do! updatePagePermalinks page.id [] page.priorPermalinks
do! updatePageRevisions page.id [] page.revisions
}
member _.all webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId ORDER BY LOWER(title)"
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore
let noText rdr = { Map.toPage rdr with text = "" }
addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync ()
return toList noText rdr
return toList pageWithoutTextOrMeta rdr
}
member _.countAll webLogId = backgroundTask {
@ -390,14 +681,8 @@ type SQLiteData (conn : SqliteConnection) =
member this.findFullById pageId webLogId = backgroundTask {
match! this.findById pageId webLogId with
| Some page ->
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM page_permalink WHERE page_id = @pageId"
cmd.Parameters.AddWithValue ("@pageId", PageId.toString page.id) |> ignore
use! linkRdr = cmd.ExecuteReaderAsync ()
let page = { page with priorPermalinks = toList Map.toPermalink linkRdr }
cmd.CommandText <- "SELECT * FROM page_revision WHERE page_id = @pageId"
use! revRdr = cmd.ExecuteReaderAsync ()
return Some { page with revisions = toList Map.toRevision revRdr }
let! page = appendPageRevisionsAndPermalinks page
return Some page
| None -> return None
}
@ -450,36 +735,89 @@ type SQLiteData (conn : SqliteConnection) =
return if rdr.Read () then Some (Map.toPermalink rdr) else None
}
member _.findFullByWebLog webLogId =
Collection.Page.Find (fun p -> p.webLogId = webLogId)
|> toList
member _.findListed webLogId =
Collection.Page.Find (fun p -> p.webLogId = webLogId && p.showInPageList)
|> Seq.map pageWithoutText
|> Seq.sortBy pageSort
|> toList
member _.findPageOfPages webLogId pageNbr =
Collection.Page.Find (fun p -> p.webLogId = webLogId)
|> Seq.map pageWithoutRevisions
|> Seq.sortBy pageSort
|> toPagedList pageNbr 25
member _.restore pages = backgroundTask {
let _ = Collection.Page.InsertBulk pages
do! checkpoint ()
member _.findFullByWebLog webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId"
addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync ()
let! pages =
toList Map.toPage rdr
|> List.map (fun page -> backgroundTask {
let! page = appendPageMeta page
return! appendPageRevisionsAndPermalinks page
})
|> Task.WhenAll
return List.ofArray pages
}
member _.update page = backgroundTask {
let _ = Collection.Page.Update page
do! checkpoint ()
member _.findListed webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""SELECT *
FROM page
WHERE web_log_id = @webLogId
AND show_in_page_list = @showInPageList
ORDER BY LOWER(title)"""
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@showInPageList", true) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
let! pages =
toList pageWithoutTextOrMeta rdr
|> List.map (fun page -> backgroundTask { return! appendPageMeta page })
|> Task.WhenAll
return List.ofArray pages
}
member _.findPageOfPages webLogId pageNbr = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""SELECT *
FROM page
WHERE web_log_id = @webLogId
ORDER BY LOWER(title)
LIMIT @pageSize OFFSET @toSkip"""
addWebLogId cmd webLogId
[ cmd.Parameters.AddWithValue ("@pageSize", 26)
cmd.Parameters.AddWithValue ("@offset", pageNbr * 25)
] |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return toList Map.toPage rdr
}
member this.restore pages = backgroundTask {
for page in pages do
do! this.add page
}
member this.update page = backgroundTask {
match! this.findFullById page.id page.webLogId with
| Some oldPage ->
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""UPDATE page
SET author_id = @authorId,
title = @title,
permalink = @permalink,
published_on = @publishedOn,
updated_on = @updatedOn,
show_in_page_list = @showInPageList,
template = @template,
page_text = @text
WHERE id = @pageId
AND web_log_id = @webLogId"""
addPageParameters cmd page
do! write cmd
do! updatePageMeta page.id oldPage.metadata page.metadata
do! updatePagePermalinks page.id oldPage.priorPermalinks page.priorPermalinks
do! updatePageRevisions page.id oldPage.revisions page.revisions
return ()
| None -> return ()
}
member this.updatePriorPermalinks pageId webLogId permalinks = backgroundTask {
match! this.findFullById pageId webLogId with
| Some page ->
do! this.update { page with priorPermalinks = permalinks }
do! updatePagePermalinks pageId page.priorPermalinks permalinks
return true
| None -> return false
}
@ -489,43 +827,113 @@ type SQLiteData (conn : SqliteConnection) =
new IPostData with
member _.add post = backgroundTask {
let _ = Collection.Post.Insert post
do! checkpoint ()
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""INSERT INTO post
VALUES (@id, @webLogId, @authorId, @status, @title, @permalink, @publishedOn, @updatedOn,
@template, @text)"""
addPostParameters cmd post
do! write cmd
do! updatePostCategories post.id [] post.categoryIds
do! updatePostTags post.id [] post.tags
do! updatePostMeta post.id [] post.metadata
do! updatePostPermalinks post.id [] post.priorPermalinks
do! updatePostRevisions post.id [] post.revisions
}
member _.countByStatus status webLogId =
Collection.Post.Count (fun p -> p.webLogId = webLogId && p.status = status)
|> Task.FromResult
member _.countByStatus status webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"SELECT COUNT(page_id) FROM page WHERE web_log_id = @webLogId AND status = @status"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@status", PostStatus.toString status) |> ignore
return! count cmd
}
member _.findByPermalink permalink webLogId =
Collection.Post.Find (fun p -> p.webLogId = webLogId && p.permalink = permalink)
|> tryFirst
member _.findByPermalink permalink webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM post WHERE web_log_id = @webLogId AND permalink = @link"
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@link", Permalink.toString permalink) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
if rdr.Read () then
let! post = appendPostCategoryTagAndMeta (Map.toPost rdr)
return Some post
else
return None
}
member _.findFullById postId webLogId =
Collection.Post.FindById (PostIdMapping.toBson postId)
//|> verifyWebLog webLogId (fun p -> p.webLogId)
member _.findFullById postId webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM post WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
if rdr.Read () then
match verifyWebLog<Post> webLogId (fun p -> p.webLogId) Map.toPost rdr with
| Some post ->
let! post = appendPostCategoryTagAndMeta post
let! post = appendPostRevisionsAndPermalinks post
return Some post
| None ->
return None
else
return None
}
member this.delete postId webLogId = backgroundTask {
match! this.findFullById postId webLogId with
| Some _ ->
let _ = Collection.Post.Delete (PostIdMapping.toBson postId)
do! checkpoint ()
use cmd = conn.CreateCommand ()
cmd.CommandText <- "DELETE FROM post_revision WHERE post_id = @id"
cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore
do! write cmd
cmd.CommandText <- "DELETE FROM post_permalink WHERE post_id = @id"
do! write cmd
cmd.CommandText <- "DELETE FROM post_meta WHERE post_id = @id"
do! write cmd
cmd.CommandText <- "DELETE FROM post_tag WHERE post_id = @id"
do! write cmd
cmd.CommandText <- "DELETE FROM post_category WHERE post_id = @id"
do! write cmd
cmd.CommandText <- "DELETE FROM post WHERE id = @id"
do! write cmd
return true
| None -> return false
}
member _.findCurrentPermalink permalinks webLogId = backgroundTask {
let! result =
Collection.Post.Find (fun p ->
p.webLogId = webLogId
&& p.priorPermalinks |> List.exists (fun link -> permalinks |> List.contains link))
|> tryFirst
return result |> Option.map (fun post -> post.permalink)
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""SELECT p.permalink
FROM post p
INNER JOIN post_permalink pp ON pp.post_id = p.id
WHERE p.web_log_id = @webLogId
AND pp.permalink IN ("""
permalinks
|> List.iteri (fun idx link ->
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
cmd.CommandText <- $"{cmd.CommandText}@link{idx}"
cmd.Parameters.AddWithValue ($"@link{idx}", Permalink.toString link) |> ignore)
cmd.CommandText <- $"{cmd.CommandText})"
addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync ()
return if rdr.Read () then Some (Map.toPermalink rdr) else None
}
member _.findFullByWebLog webLogId =
Collection.Post.Find (fun p -> p.webLogId = webLogId)
|> toList
member _.findFullByWebLog webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM post WHERE web_log_id = @webLogId"
addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync ()
let! posts =
toList Map.toPost rdr
|> List.map (fun post -> backgroundTask {
let! post = appendPostCategoryTagAndMeta post
return! appendPostRevisionsAndPermalinks post
})
|> Task.WhenAll
return List.ofArray posts
}
member _.findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage =
Collection.Post.Find (fun p ->
@ -571,20 +979,41 @@ type SQLiteData (conn : SqliteConnection) =
return older, newer
}
member _.restore posts = backgroundTask {
let _ = Collection.Post.InsertBulk posts
do! checkpoint ()
member this.restore posts = backgroundTask {
for post in posts do
do! this.add post
}
member _.update post = backgroundTask {
let _ = Collection.Post.Update post
do! checkpoint ()
member this.update post = backgroundTask {
match! this.findFullById post.id post.webLogId with
| Some oldPost ->
use cmd = conn.CreateCommand ()
cmd.CommandText <-
"""UPDATE post
SET author_id = @author_id,
status = @status,
title = @title,
permalink = @permalink,
published_on = @publishedOn,
updated_on = @updatedOn,
template = @template,
post_text = @text
WHERE id = @id
AND web_log_id = @webLogId"""
addPostParameters cmd post
do! write cmd
do! updatePostCategories post.id oldPost.categoryIds post.categoryIds
do! updatePostTags post.id oldPost.tags post.tags
do! updatePostMeta post.id oldPost.metadata post.metadata
do! updatePostPermalinks post.id oldPost.priorPermalinks post.priorPermalinks
do! updatePostRevisions post.id oldPost.revisions post.revisions
| None -> return ()
}
member this.updatePriorPermalinks postId webLogId permalinks = backgroundTask {
match! this.findFullById postId webLogId with
| Some post ->
do! this.update { post with priorPermalinks = permalinks }
do! updatePostPermalinks postId post.priorPermalinks permalinks
return true
| None -> return false
}