From 554e22f998262d91a0ca01b2ca2281a1d02a2234 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Fri, 17 Jun 2022 20:11:25 -0400 Subject: [PATCH] WIP beginnings of SQLite impl --- src/MyWebLog.Data/MyWebLog.Data.fsproj | 2 + src/MyWebLog.Data/SQLiteData.fs | 555 +++++++++++++++++++++++++ 2 files changed, 557 insertions(+) create mode 100644 src/MyWebLog.Data/SQLiteData.fs diff --git a/src/MyWebLog.Data/MyWebLog.Data.fsproj b/src/MyWebLog.Data/MyWebLog.Data.fsproj index 47a2a2e..244c2ba 100644 --- a/src/MyWebLog.Data/MyWebLog.Data.fsproj +++ b/src/MyWebLog.Data/MyWebLog.Data.fsproj @@ -11,6 +11,7 @@ + @@ -25,6 +26,7 @@ + diff --git a/src/MyWebLog.Data/SQLiteData.fs b/src/MyWebLog.Data/SQLiteData.fs new file mode 100644 index 0000000..e3ef7ca --- /dev/null +++ b/src/MyWebLog.Data/SQLiteData.fs @@ -0,0 +1,555 @@ +namespace MyWebLog.Data + +open System +open System.Threading.Tasks +open Microsoft.Data.Sqlite +open MyWebLog +open MyWebLog.ViewModels + +type SQLiteData (conn : SqliteConnection) = + + member _.x = "" + +// /// Shorthand for accessing the collections in the LiteDB database +// let Collection = {| +// Category = db.GetCollection "Category" +// Comment = db.GetCollection "Comment" +// Page = db.GetCollection "Page" +// Post = db.GetCollection "Post" +// TagMap = db.GetCollection "TagMap" +// Theme = db.GetCollection "Theme" +// ThemeAsset = db.GetCollection "ThemeAsset" +// WebLog = db.GetCollection "WebLog" +// WebLogUser = db.GetCollection "WebLogUser" +// |} + + /// Return a page with no revisions or prior permalinks + let pageWithoutRevisions (page : Page) = + { page with revisions = []; priorPermalinks = [] } + + /// Return a page with no revisions, prior permalinks, or text + let pageWithoutText page = + { pageWithoutRevisions page with text = "" } + + /// Sort function for pages + let pageSort (page : Page) = + page.title.ToLowerInvariant () + + /// 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 = "" } + + /// The connection for this instance + member _.Conn = conn + + interface IData with + + member _.Category = { + new ICategoryData with + + member _.add cat = backgroundTask { + use cmd = conn.CreateCommand () + cmd.CommandText <- + "INSERT INTO Category VALUES (@id, @webLogId, @name, @slug, @description, @parentId)" + [ cmd.Parameters.AddWithValue ("@id", CategoryId.toString cat.id) + cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString cat.webLogId) + cmd.Parameters.AddWithValue ("@name", cat.name) + cmd.Parameters.AddWithValue ("@slug", cat.slug) + cmd.Parameters.AddWithValue ("@description", + match cat.description with + | Some d -> d :> obj + | None -> DBNull.Value) + cmd.Parameters.AddWithValue ("@parentId", + match cat.parentId with + | Some (CategoryId parentId) -> parentId :> obj + | None -> DBNull.Value) + ] + |> ignore + let! _ = cmd.ExecuteNonQueryAsync () + () + } + + member _.countAll webLogId = backgroundTask { + use cmd = conn.CreateCommand () + cmd.CommandText <- "SELECT COUNT(id) FROM Category WHERE webLogId = @webLpgId" + cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore + let! result = cmd.ExecuteScalarAsync () + return result :?> int + } + + member _.countTopLevel webLogId = + Collection.Category.Count(fun cat -> cat.webLogId = webLogId && Option.isNone cat.parentId) + |> Task.FromResult + + member _.findAllForView webLogId = backgroundTask { + let cats = + Collection.Category.Find (fun cat -> cat.webLogId = webLogId) + |> Seq.sortBy (fun cat -> cat.name.ToLowerInvariant ()) + |> List.ofSeq + let ordered = orderByHierarchy cats None None [] + let! counts = + ordered + |> Seq.map (fun it -> backgroundTask { + // Parent category post counts include posts in subcategories + let catIds = + ordered + |> Seq.filter (fun cat -> cat.parentNames |> Array.contains it.name) + |> Seq.map (fun cat -> cat.id :> obj) + |> Seq.append (Seq.singleton it.id) + |> List.ofSeq + let count = + Collection.Post.Count (fun p -> + p.webLogId = webLogId + && p.status = Published + && p.categoryIds |> List.exists (fun cId -> catIds |> List.contains cId)) + return it.id, count + }) + |> Task.WhenAll + return + ordered + |> Seq.map (fun cat -> + { cat with + postCount = counts + |> Array.tryFind (fun c -> fst c = cat.id) + |> Option.map snd + |> Option.defaultValue 0 + }) + |> Array.ofSeq + } + + member _.findById catId webLogId = + Collection.Category.FindById (CategoryIdMapping.toBson catId) + |> verifyWebLog webLogId (fun c -> c.webLogId) + + member _.findByWebLog webLogId = + Collection.Category.Find (fun c -> c.webLogId = webLogId) + |> toList + + member this.delete catId webLogId = backgroundTask { + match! this.findById catId webLogId with + | Some _ -> + // Delete the category off all posts where it is assigned + Collection.Post.Find (fun p -> p.webLogId = webLogId && p.categoryIds |> List.contains catId) + |> Seq.map (fun p -> + { p with categoryIds = p.categoryIds |> List.filter (fun cId -> cId <> catId) }) + |> Collection.Post.Update + |> ignore + // Delete the category itself + let _ = Collection.Category.Delete (CategoryIdMapping.toBson catId) + do! checkpoint () + return true + | None -> return false + } + + member _.restore cats = backgroundTask { + let _ = Collection.Category.InsertBulk cats + do! checkpoint () + } + + member _.update cat = backgroundTask { + let _ = Collection.Category.Update cat + do! checkpoint () + } + } + + member _.Page = { + new IPageData with + + member _.add page = backgroundTask { + let _ = Collection.Page.Insert page + do! checkpoint () + } + + member _.all webLogId = + Collection.Page.Find (fun p -> p.webLogId = webLogId) + |> Seq.map pageWithoutText + |> Seq.sortBy pageSort + |> toList + + member _.countAll webLogId = + Collection.Page.Count (fun p -> p.webLogId = webLogId) + |> Task.FromResult + + member _.countListed webLogId = + Collection.Page.Count (fun p -> p.webLogId = webLogId && p.showInPageList) + |> Task.FromResult + + member _.findFullById pageId webLogId = + Collection.Page.FindById (PageIdMapping.toBson pageId) + |> verifyWebLog webLogId (fun it -> it.webLogId) + + member this.findById pageId webLogId = backgroundTask { + let! page = this.findFullById pageId webLogId + return page |> Option.map pageWithoutRevisions + } + + member this.delete pageId webLogId = backgroundTask { + match! this.findById pageId webLogId with + | Some _ -> + let _ = Collection.Page.Delete (PageIdMapping.toBson pageId) + do! checkpoint () + return true + | None -> return false + } + + member _.findByPermalink permalink webLogId = backgroundTask { + let! page = + Collection.Page.Find (fun p -> p.webLogId = webLogId && p.permalink = permalink) + |> tryFirst + return page |> Option.map pageWithoutRevisions + } + + member _.findCurrentPermalink permalinks webLogId = backgroundTask { + let! result = + Collection.Page.Find (fun p -> + p.webLogId = webLogId + && p.priorPermalinks |> List.exists (fun link -> permalinks |> List.contains link)) + |> tryFirst + return result |> Option.map (fun pg -> pg.permalink) + } + + 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 _.update page = backgroundTask { + let _ = Collection.Page.Update page + do! checkpoint () + } + + member this.updatePriorPermalinks pageId webLogId permalinks = backgroundTask { + match! this.findFullById pageId webLogId with + | Some page -> + do! this.update { page with priorPermalinks = permalinks } + return true + | None -> return false + } + } + + member _.Post = { + new IPostData with + + member _.add post = backgroundTask { + let _ = Collection.Post.Insert post + do! checkpoint () + } + + member _.countByStatus status webLogId = + Collection.Post.Count (fun p -> p.webLogId = webLogId && p.status = status) + |> Task.FromResult + + member _.findByPermalink permalink webLogId = + Collection.Post.Find (fun p -> p.webLogId = webLogId && p.permalink = permalink) + |> tryFirst + + member _.findFullById postId webLogId = + Collection.Post.FindById (PostIdMapping.toBson postId) + |> verifyWebLog webLogId (fun p -> p.webLogId) + + member this.delete postId webLogId = backgroundTask { + match! this.findFullById postId webLogId with + | Some _ -> + let _ = Collection.Post.Delete (PostIdMapping.toBson postId) + do! checkpoint () + 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) + } + + member _.findFullByWebLog webLogId = + Collection.Post.Find (fun p -> p.webLogId = webLogId) + |> toList + + 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 _.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 _.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 _.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 _.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 + return older, newer + } + + member _.restore posts = backgroundTask { + let _ = Collection.Post.InsertBulk posts + do! checkpoint () + } + + member _.update post = backgroundTask { + let _ = Collection.Post.Update post + do! checkpoint () + } + + member this.updatePriorPermalinks postId webLogId permalinks = backgroundTask { + match! this.findFullById postId webLogId with + | Some post -> + do! this.update { post with priorPermalinks = permalinks } + return true + | None -> return false + } + } + + member _.TagMap = { + new ITagMapData with + + member _.findById tagMapId webLogId = + Collection.TagMap.FindById (TagMapIdMapping.toBson tagMapId) + |> verifyWebLog webLogId (fun tm -> tm.webLogId) + + member this.delete tagMapId webLogId = backgroundTask { + match! this.findById tagMapId webLogId with + | Some _ -> + let _ = Collection.TagMap.Delete (TagMapIdMapping.toBson tagMapId) + do! checkpoint () + 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 _.save tagMap = backgroundTask { + let _ = Collection.TagMap.Upsert tagMap + do! checkpoint () + } + } + + 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 _.findById themeId = + Collection.Theme.FindById (ThemeIdMapping.toBson themeId) + |> toOption + + member this.findByIdWithoutText themeId = backgroundTask { + match! this.findById themeId with + | Some theme -> + return Some { + theme with templates = theme.templates |> List.map (fun t -> { t with text = "" }) + } + | None -> return None + } + + member _.save theme = backgroundTask { + let _ = Collection.Theme.Upsert theme + do! checkpoint () + } + } + + 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 _.findById assetId = + Collection.ThemeAsset.FindById (ThemeAssetIdMapping.toBson assetId) + |> toOption + + 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 _.findByThemeWithData themeId = + Collection.ThemeAsset.Find (fun ta -> + (ThemeAssetId.toString ta.id).StartsWith (ThemeId.toString themeId)) + |> toList + + member _.save asset = backgroundTask { + let _ = Collection.ThemeAsset.Upsert asset + do! checkpoint () + } + } + + member _.WebLog = { + new IWebLogData with + + member _.add webLog = backgroundTask { + let _ = Collection.WebLog.Insert webLog + do! checkpoint () + } + + member _.all () = + Collection.WebLog.FindAll () + |> toList + + 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 () + } + + member _.findByHost url = + Collection.WebLog.Find (fun wl -> wl.urlBase = url) + |> tryFirst + + member _.findById webLogId = + Collection.WebLog.FindById (WebLogIdMapping.toBson webLogId) + |> toOption + + member _.updateSettings webLog = backgroundTask { + let _ = Collection.WebLog.Update webLog + do! checkpoint () + } + + member this.updateRssOptions webLog = backgroundTask { + match! this.findById webLog.id with + | Some wl -> do! this.updateSettings { wl with rss = webLog.rss } + | None -> () + } + } + + member _.WebLogUser = { + new IWebLogUserData with + + member _.add user = backgroundTask { + let _ = Collection.WebLogUser.Insert user + do! checkpoint () + } + + member _.findByEmail email webLogId = + Collection.WebLogUser.Find (fun wlu -> wlu.webLogId = webLogId && wlu.userName = email) + |> tryFirst + + member _.findById userId webLogId = + Collection.WebLogUser.FindById (WebLogUserIdMapping.toBson userId) + |> verifyWebLog webLogId (fun u -> u.webLogId) + + member _.findByWebLog webLogId = + Collection.WebLogUser.Find (fun wlu -> wlu.webLogId = webLogId) + |> toList + + member _.findNames webLogId userIds = + Collection.WebLogUser.Find (fun wlu -> userIds |> List.contains wlu.id) + |> Seq.map (fun u -> { name = WebLogUserId.toString u.id; value = WebLogUser.displayName u }) + |> toList + + member _.restore users = backgroundTask { + let _ = Collection.WebLogUser.InsertBulk users + do! checkpoint () + } + + member _.update user = backgroundTask { + let _ = Collection.WebLogUser.Update user + do! checkpoint () + } + } + + member _.startUp () = backgroundTask { + + let _ = Collection.Category.EnsureIndex (fun c -> c.webLogId) + let _ = Collection.Comment.EnsureIndex (fun c -> c.postId) + let _ = Collection.Page.EnsureIndex (fun p -> p.webLogId) + let _ = Collection.Page.EnsureIndex (fun p -> p.authorId) + let _ = Collection.Post.EnsureIndex (fun p -> p.webLogId) + let _ = Collection.Post.EnsureIndex (fun p -> p.authorId) + let _ = Collection.TagMap.EnsureIndex (fun tm -> tm.webLogId) + let _ = Collection.WebLog.EnsureIndex (fun wl -> wl.urlBase) + let _ = Collection.WebLogUser.EnsureIndex (fun wlu -> wlu.webLogId) + + do! checkpoint () + } +