Version 2, ready for beta
This commit was merged in pull request #1.
This commit is contained in:
GitHub
132
src/MyWebLog.Data/Converters.fs
Normal file
132
src/MyWebLog.Data/Converters.fs
Normal file
@@ -0,0 +1,132 @@
|
||||
/// Converters for discriminated union types
|
||||
module MyWebLog.Converters
|
||||
|
||||
open MyWebLog
|
||||
open System
|
||||
|
||||
/// JSON.NET converters for discriminated union types
|
||||
module Json =
|
||||
|
||||
open Newtonsoft.Json
|
||||
|
||||
type CategoryIdConverter () =
|
||||
inherit JsonConverter<CategoryId> ()
|
||||
override _.WriteJson (writer : JsonWriter, value : CategoryId, _ : JsonSerializer) =
|
||||
writer.WriteValue (CategoryId.toString value)
|
||||
override _.ReadJson (reader : JsonReader, _ : Type, _ : CategoryId, _ : bool, _ : JsonSerializer) =
|
||||
(string >> CategoryId) reader.Value
|
||||
|
||||
type CommentIdConverter () =
|
||||
inherit JsonConverter<CommentId> ()
|
||||
override _.WriteJson (writer : JsonWriter, value : CommentId, _ : JsonSerializer) =
|
||||
writer.WriteValue (CommentId.toString value)
|
||||
override _.ReadJson (reader : JsonReader, _ : Type, _ : CommentId, _ : bool, _ : JsonSerializer) =
|
||||
(string >> CommentId) reader.Value
|
||||
|
||||
type CustomFeedIdConverter () =
|
||||
inherit JsonConverter<CustomFeedId> ()
|
||||
override _.WriteJson (writer : JsonWriter, value : CustomFeedId, _ : JsonSerializer) =
|
||||
writer.WriteValue (CustomFeedId.toString value)
|
||||
override _.ReadJson (reader : JsonReader, _ : Type, _ : CustomFeedId, _ : bool, _ : JsonSerializer) =
|
||||
(string >> CustomFeedId) reader.Value
|
||||
|
||||
type CustomFeedSourceConverter () =
|
||||
inherit JsonConverter<CustomFeedSource> ()
|
||||
override _.WriteJson (writer : JsonWriter, value : CustomFeedSource, _ : JsonSerializer) =
|
||||
writer.WriteValue (CustomFeedSource.toString value)
|
||||
override _.ReadJson (reader : JsonReader, _ : Type, _ : CustomFeedSource, _ : bool, _ : JsonSerializer) =
|
||||
(string >> CustomFeedSource.parse) reader.Value
|
||||
|
||||
type ExplicitRatingConverter () =
|
||||
inherit JsonConverter<ExplicitRating> ()
|
||||
override _.WriteJson (writer : JsonWriter, value : ExplicitRating, _ : JsonSerializer) =
|
||||
writer.WriteValue (ExplicitRating.toString value)
|
||||
override _.ReadJson (reader : JsonReader, _ : Type, _ : ExplicitRating, _ : bool, _ : JsonSerializer) =
|
||||
(string >> ExplicitRating.parse) reader.Value
|
||||
|
||||
type MarkupTextConverter () =
|
||||
inherit JsonConverter<MarkupText> ()
|
||||
override _.WriteJson (writer : JsonWriter, value : MarkupText, _ : JsonSerializer) =
|
||||
writer.WriteValue (MarkupText.toString value)
|
||||
override _.ReadJson (reader : JsonReader, _ : Type, _ : MarkupText, _ : bool, _ : JsonSerializer) =
|
||||
(string >> MarkupText.parse) reader.Value
|
||||
|
||||
type PermalinkConverter () =
|
||||
inherit JsonConverter<Permalink> ()
|
||||
override _.WriteJson (writer : JsonWriter, value : Permalink, _ : JsonSerializer) =
|
||||
writer.WriteValue (Permalink.toString value)
|
||||
override _.ReadJson (reader : JsonReader, _ : Type, _ : Permalink, _ : bool, _ : JsonSerializer) =
|
||||
(string >> Permalink) reader.Value
|
||||
|
||||
type PageIdConverter () =
|
||||
inherit JsonConverter<PageId> ()
|
||||
override _.WriteJson (writer : JsonWriter, value : PageId, _ : JsonSerializer) =
|
||||
writer.WriteValue (PageId.toString value)
|
||||
override _.ReadJson (reader : JsonReader, _ : Type, _ : PageId, _ : bool, _ : JsonSerializer) =
|
||||
(string >> PageId) reader.Value
|
||||
|
||||
type PostIdConverter () =
|
||||
inherit JsonConverter<PostId> ()
|
||||
override _.WriteJson (writer : JsonWriter, value : PostId, _ : JsonSerializer) =
|
||||
writer.WriteValue (PostId.toString value)
|
||||
override _.ReadJson (reader : JsonReader, _ : Type, _ : PostId, _ : bool, _ : JsonSerializer) =
|
||||
(string >> PostId) reader.Value
|
||||
|
||||
type TagMapIdConverter () =
|
||||
inherit JsonConverter<TagMapId> ()
|
||||
override _.WriteJson (writer : JsonWriter, value : TagMapId, _ : JsonSerializer) =
|
||||
writer.WriteValue (TagMapId.toString value)
|
||||
override _.ReadJson (reader : JsonReader, _ : Type, _ : TagMapId, _ : bool, _ : JsonSerializer) =
|
||||
(string >> TagMapId) reader.Value
|
||||
|
||||
type ThemeAssetIdConverter () =
|
||||
inherit JsonConverter<ThemeAssetId> ()
|
||||
override _.WriteJson (writer : JsonWriter, value : ThemeAssetId, _ : JsonSerializer) =
|
||||
writer.WriteValue (ThemeAssetId.toString value)
|
||||
override _.ReadJson (reader : JsonReader, _ : Type, _ : ThemeAssetId, _ : bool, _ : JsonSerializer) =
|
||||
(string >> ThemeAssetId.ofString) reader.Value
|
||||
|
||||
type ThemeIdConverter () =
|
||||
inherit JsonConverter<ThemeId> ()
|
||||
override _.WriteJson (writer : JsonWriter, value : ThemeId, _ : JsonSerializer) =
|
||||
writer.WriteValue (ThemeId.toString value)
|
||||
override _.ReadJson (reader : JsonReader, _ : Type, _ : ThemeId, _ : bool, _ : JsonSerializer) =
|
||||
(string >> ThemeId) reader.Value
|
||||
|
||||
type WebLogIdConverter () =
|
||||
inherit JsonConverter<WebLogId> ()
|
||||
override _.WriteJson (writer : JsonWriter, value : WebLogId, _ : JsonSerializer) =
|
||||
writer.WriteValue (WebLogId.toString value)
|
||||
override _.ReadJson (reader : JsonReader, _ : Type, _ : WebLogId, _ : bool, _ : JsonSerializer) =
|
||||
(string >> WebLogId) reader.Value
|
||||
|
||||
type WebLogUserIdConverter () =
|
||||
inherit JsonConverter<WebLogUserId> ()
|
||||
override _.WriteJson (writer : JsonWriter, value : WebLogUserId, _ : JsonSerializer) =
|
||||
writer.WriteValue (WebLogUserId.toString value)
|
||||
override _.ReadJson (reader : JsonReader, _ : Type, _ : WebLogUserId, _ : bool, _ : JsonSerializer) =
|
||||
(string >> WebLogUserId) reader.Value
|
||||
|
||||
open Microsoft.FSharpLu.Json
|
||||
|
||||
/// All converters to use for data conversion
|
||||
let all () : JsonConverter seq =
|
||||
seq {
|
||||
// Our converters
|
||||
CategoryIdConverter ()
|
||||
CommentIdConverter ()
|
||||
CustomFeedIdConverter ()
|
||||
CustomFeedSourceConverter ()
|
||||
ExplicitRatingConverter ()
|
||||
MarkupTextConverter ()
|
||||
PermalinkConverter ()
|
||||
PageIdConverter ()
|
||||
PostIdConverter ()
|
||||
TagMapIdConverter ()
|
||||
ThemeAssetIdConverter ()
|
||||
ThemeIdConverter ()
|
||||
WebLogIdConverter ()
|
||||
WebLogUserIdConverter ()
|
||||
// Handles DUs with no associated data, as well as option fields
|
||||
CompactUnionJsonConverter ()
|
||||
}
|
||||
281
src/MyWebLog.Data/Interfaces.fs
Normal file
281
src/MyWebLog.Data/Interfaces.fs
Normal file
@@ -0,0 +1,281 @@
|
||||
namespace MyWebLog.Data
|
||||
|
||||
open System
|
||||
open System.Threading.Tasks
|
||||
open MyWebLog
|
||||
open MyWebLog.ViewModels
|
||||
|
||||
/// Data functions to support manipulating categories
|
||||
type ICategoryData =
|
||||
|
||||
/// Add a category
|
||||
abstract member add : Category -> Task<unit>
|
||||
|
||||
/// Count all categories for the given web log
|
||||
abstract member countAll : WebLogId -> Task<int>
|
||||
|
||||
/// Count all top-level categories for the given web log
|
||||
abstract member countTopLevel : WebLogId -> Task<int>
|
||||
|
||||
/// Delete a category (also removes it from posts)
|
||||
abstract member delete : CategoryId -> WebLogId -> Task<bool>
|
||||
|
||||
/// Find all categories for a web log, sorted alphabetically and grouped by hierarchy
|
||||
abstract member findAllForView : WebLogId -> Task<DisplayCategory[]>
|
||||
|
||||
/// Find a category by its ID
|
||||
abstract member findById : CategoryId -> WebLogId -> Task<Category option>
|
||||
|
||||
/// Find all categories for the given web log
|
||||
abstract member findByWebLog : WebLogId -> Task<Category list>
|
||||
|
||||
/// Restore categories from a backup
|
||||
abstract member restore : Category list -> Task<unit>
|
||||
|
||||
/// Update a category (slug, name, description, and parent ID)
|
||||
abstract member update : Category -> Task<unit>
|
||||
|
||||
|
||||
/// Data functions to support manipulating pages
|
||||
type IPageData =
|
||||
|
||||
/// Add a page
|
||||
abstract member add : Page -> Task<unit>
|
||||
|
||||
/// 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
|
||||
abstract member countAll : WebLogId -> Task<int>
|
||||
|
||||
/// Count pages marked as "show in page list" for the given web log
|
||||
abstract member countListed : WebLogId -> Task<int>
|
||||
|
||||
/// Delete a page
|
||||
abstract member delete : PageId -> WebLogId -> Task<bool>
|
||||
|
||||
/// Find a page by its ID (excluding revisions and prior permalinks)
|
||||
abstract member findById : PageId -> WebLogId -> Task<Page option>
|
||||
|
||||
/// Find a page by its permalink (excluding revisions and prior permalinks)
|
||||
abstract member findByPermalink : Permalink -> WebLogId -> Task<Page option>
|
||||
|
||||
/// Find the current permalink for a page from a list of prior permalinks
|
||||
abstract member findCurrentPermalink : Permalink list -> WebLogId -> Task<Permalink option>
|
||||
|
||||
/// Find a page by its ID (including revisions and prior permalinks)
|
||||
abstract member findFullById : PageId -> WebLogId -> Task<Page option>
|
||||
|
||||
/// Find all pages for the given web log (including revisions and prior permalinks)
|
||||
abstract member findFullByWebLog : WebLogId -> Task<Page list>
|
||||
|
||||
/// 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 meta items, revisions and prior permalinks)
|
||||
abstract member findPageOfPages : WebLogId -> pageNbr : int -> Task<Page list>
|
||||
|
||||
/// Restore pages from a backup
|
||||
abstract member restore : Page list -> Task<unit>
|
||||
|
||||
/// Update a page
|
||||
abstract member update : Page -> Task<unit>
|
||||
|
||||
/// Update the prior permalinks for the given page
|
||||
abstract member updatePriorPermalinks : PageId -> WebLogId -> Permalink list -> Task<bool>
|
||||
|
||||
|
||||
/// Data functions to support manipulating posts
|
||||
type IPostData =
|
||||
|
||||
/// Add a post
|
||||
abstract member add : Post -> Task<unit>
|
||||
|
||||
/// Count posts by their status
|
||||
abstract member countByStatus : PostStatus -> WebLogId -> Task<int>
|
||||
|
||||
/// Delete a post
|
||||
abstract member delete : PostId -> WebLogId -> Task<bool>
|
||||
|
||||
/// Find a post by its permalink (excluding revisions and prior permalinks)
|
||||
abstract member findByPermalink : Permalink -> WebLogId -> Task<Post option>
|
||||
|
||||
/// Find the current permalink for a post from a list of prior permalinks
|
||||
abstract member findCurrentPermalink : Permalink list -> WebLogId -> Task<Permalink option>
|
||||
|
||||
/// Find a post by its ID (including revisions and prior permalinks)
|
||||
abstract member findFullById : PostId -> WebLogId -> Task<Post option>
|
||||
|
||||
/// Find all posts for the given web log (including revisions and prior permalinks)
|
||||
abstract member findFullByWebLog : WebLogId -> Task<Post list>
|
||||
|
||||
/// Find posts to be displayed on a category list page (excluding revisions and prior permalinks)
|
||||
abstract member findPageOfCategorizedPosts :
|
||||
WebLogId -> CategoryId list -> pageNbr : int -> postsPerPage : int -> Task<Post list>
|
||||
|
||||
/// Find posts to be displayed on an admin page (excluding revisions and prior permalinks)
|
||||
abstract member findPageOfPosts : WebLogId -> pageNbr : int -> postsPerPage : int -> Task<Post list>
|
||||
|
||||
/// Find posts to be displayed on a page (excluding revisions and prior permalinks)
|
||||
abstract member findPageOfPublishedPosts : WebLogId -> pageNbr : int -> postsPerPage : int -> Task<Post list>
|
||||
|
||||
/// Find posts to be displayed on a tag list page (excluding revisions and prior permalinks)
|
||||
abstract member findPageOfTaggedPosts :
|
||||
WebLogId -> tag : string -> pageNbr : int -> postsPerPage : int -> Task<Post list>
|
||||
|
||||
/// Find the next older and newer post for the given published date/time (excluding revisions and prior permalinks)
|
||||
abstract member findSurroundingPosts : WebLogId -> publishedOn : DateTime -> Task<Post option * Post option>
|
||||
|
||||
/// Restore posts from a backup
|
||||
abstract member restore : Post list -> Task<unit>
|
||||
|
||||
/// Update a post
|
||||
abstract member update : Post -> Task<unit>
|
||||
|
||||
/// Update the prior permalinks for a post
|
||||
abstract member updatePriorPermalinks : PostId -> WebLogId -> Permalink list -> Task<bool>
|
||||
|
||||
|
||||
/// Functions to manipulate tag mappings
|
||||
type ITagMapData =
|
||||
|
||||
/// Delete a tag mapping
|
||||
abstract member delete : TagMapId -> WebLogId -> Task<bool>
|
||||
|
||||
/// Find a tag mapping by its ID
|
||||
abstract member findById : TagMapId -> WebLogId -> Task<TagMap option>
|
||||
|
||||
/// Find a tag mapping by its URL value
|
||||
abstract member findByUrlValue : string -> WebLogId -> Task<TagMap option>
|
||||
|
||||
/// Retrieve all tag mappings for the given web log
|
||||
abstract member findByWebLog : WebLogId -> Task<TagMap list>
|
||||
|
||||
/// Find tag mappings for the given tags
|
||||
abstract member findMappingForTags : tags : string list -> WebLogId -> Task<TagMap list>
|
||||
|
||||
/// Restore tag mappings from a backup
|
||||
abstract member restore : TagMap list -> Task<unit>
|
||||
|
||||
/// Save a tag mapping (insert or update)
|
||||
abstract member save : TagMap -> Task<unit>
|
||||
|
||||
|
||||
/// Functions to manipulate themes
|
||||
type IThemeData =
|
||||
|
||||
/// Retrieve all themes (except "admin")
|
||||
abstract member all : unit -> Task<Theme list>
|
||||
|
||||
/// Find a theme by its ID
|
||||
abstract member findById : ThemeId -> Task<Theme option>
|
||||
|
||||
/// Find a theme by its ID (excluding the text of its templates)
|
||||
abstract member findByIdWithoutText : ThemeId -> Task<Theme option>
|
||||
|
||||
/// Save a theme (insert or update)
|
||||
abstract member save : Theme -> Task<unit>
|
||||
|
||||
|
||||
/// Functions to manipulate theme assets
|
||||
type IThemeAssetData =
|
||||
|
||||
/// Retrieve all theme assets (excluding data)
|
||||
abstract member all : unit -> Task<ThemeAsset list>
|
||||
|
||||
/// Delete all theme assets for the given theme
|
||||
abstract member deleteByTheme : ThemeId -> Task<unit>
|
||||
|
||||
/// Find a theme asset by its ID
|
||||
abstract member findById : ThemeAssetId -> Task<ThemeAsset option>
|
||||
|
||||
/// Find all assets for the given theme (excludes data)
|
||||
abstract member findByTheme : ThemeId -> Task<ThemeAsset list>
|
||||
|
||||
/// Find all assets for the given theme (includes data)
|
||||
abstract member findByThemeWithData : ThemeId -> Task<ThemeAsset list>
|
||||
|
||||
/// Save a theme asset (insert or update)
|
||||
abstract member save : ThemeAsset -> Task<unit>
|
||||
|
||||
|
||||
/// Functions to manipulate web logs
|
||||
type IWebLogData =
|
||||
|
||||
/// Add a web log
|
||||
abstract member add : WebLog -> Task<unit>
|
||||
|
||||
/// Retrieve all web logs
|
||||
abstract member all : unit -> Task<WebLog list>
|
||||
|
||||
/// Delete a web log, including categories, tag mappings, posts/comments, and pages
|
||||
abstract member delete : WebLogId -> Task<unit>
|
||||
|
||||
/// Find a web log by its host (URL base)
|
||||
abstract member findByHost : string -> Task<WebLog option>
|
||||
|
||||
/// Find a web log by its ID
|
||||
abstract member findById : WebLogId -> Task<WebLog option>
|
||||
|
||||
/// Update RSS options for a web log
|
||||
abstract member updateRssOptions : WebLog -> Task<unit>
|
||||
|
||||
/// Update web log settings (from the settings page)
|
||||
abstract member updateSettings : WebLog -> Task<unit>
|
||||
|
||||
|
||||
/// Functions to manipulate web log users
|
||||
type IWebLogUserData =
|
||||
|
||||
/// Add a web log user
|
||||
abstract member add : WebLogUser -> Task<unit>
|
||||
|
||||
/// Find a web log user by their e-mail address
|
||||
abstract member findByEmail : email : string -> WebLogId -> Task<WebLogUser option>
|
||||
|
||||
/// Find a web log user by their ID
|
||||
abstract member findById : WebLogUserId -> WebLogId -> Task<WebLogUser option>
|
||||
|
||||
/// Find all web log users for the given web log
|
||||
abstract member findByWebLog : WebLogId -> Task<WebLogUser list>
|
||||
|
||||
/// Get a user ID -> name dictionary for the given user IDs
|
||||
abstract member findNames : WebLogId -> WebLogUserId list -> Task<MetaItem list>
|
||||
|
||||
/// Restore users from a backup
|
||||
abstract member restore : WebLogUser list -> Task<unit>
|
||||
|
||||
/// Update a web log user
|
||||
abstract member update : WebLogUser -> Task<unit>
|
||||
|
||||
|
||||
/// Data interface required for a myWebLog data implementation
|
||||
type IData =
|
||||
|
||||
/// Category data functions
|
||||
abstract member Category : ICategoryData
|
||||
|
||||
/// Page data functions
|
||||
abstract member Page : IPageData
|
||||
|
||||
/// Post data functions
|
||||
abstract member Post : IPostData
|
||||
|
||||
/// Tag map data functions
|
||||
abstract member TagMap : ITagMapData
|
||||
|
||||
/// Theme data functions
|
||||
abstract member Theme : IThemeData
|
||||
|
||||
/// Theme asset data functions
|
||||
abstract member ThemeAsset : IThemeAssetData
|
||||
|
||||
/// Web log data functions
|
||||
abstract member WebLog : IWebLogData
|
||||
|
||||
/// Web log user data functions
|
||||
abstract member WebLogUser : IWebLogUserData
|
||||
|
||||
/// Do any required start up data checks
|
||||
abstract member startUp : unit -> Task<unit>
|
||||
|
||||
30
src/MyWebLog.Data/MyWebLog.Data.fsproj
Normal file
30
src/MyWebLog.Data/MyWebLog.Data.fsproj
Normal file
@@ -0,0 +1,30 @@
|
||||
<Project Sdk="Microsoft.NET.Sdk">
|
||||
|
||||
<PropertyGroup>
|
||||
<TargetFramework>net6.0</TargetFramework>
|
||||
<GenerateDocumentationFile>true</GenerateDocumentationFile>
|
||||
</PropertyGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<ProjectReference Include="..\MyWebLog.Domain\MyWebLog.Domain.fsproj" />
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<PackageReference Include="Microsoft.Data.Sqlite" Version="6.0.6" />
|
||||
<PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="6.0.0" />
|
||||
<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
|
||||
<PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
|
||||
<PackageReference Include="RethinkDb.Driver" Version="2.3.150" />
|
||||
<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-05" />
|
||||
<PackageReference Update="FSharp.Core" Version="6.0.5" />
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<Compile Include="Converters.fs" />
|
||||
<Compile Include="Interfaces.fs" />
|
||||
<Compile Include="Utils.fs" />
|
||||
<Compile Include="RethinkDbData.fs" />
|
||||
<Compile Include="SQLiteData.fs" />
|
||||
</ItemGroup>
|
||||
|
||||
</Project>
|
||||
885
src/MyWebLog.Data/RethinkDbData.fs
Normal file
885
src/MyWebLog.Data/RethinkDbData.fs
Normal file
@@ -0,0 +1,885 @@
|
||||
namespace MyWebLog.Data
|
||||
|
||||
open System.Threading.Tasks
|
||||
open MyWebLog
|
||||
open RethinkDb.Driver
|
||||
|
||||
/// Functions to assist with retrieving data
|
||||
[<AutoOpen>]
|
||||
module private RethinkHelpers =
|
||||
|
||||
/// Table names
|
||||
[<RequireQualifiedAccess>]
|
||||
module Table =
|
||||
|
||||
/// The category table
|
||||
let Category = "Category"
|
||||
|
||||
/// The comment table
|
||||
let Comment = "Comment"
|
||||
|
||||
/// The page table
|
||||
let Page = "Page"
|
||||
|
||||
/// The post table
|
||||
let Post = "Post"
|
||||
|
||||
/// The tag map table
|
||||
let TagMap = "TagMap"
|
||||
|
||||
/// The theme table
|
||||
let Theme = "Theme"
|
||||
|
||||
/// The theme asset table
|
||||
let ThemeAsset = "ThemeAsset"
|
||||
|
||||
/// The web log table
|
||||
let WebLog = "WebLog"
|
||||
|
||||
/// The web log user table
|
||||
let WebLogUser = "WebLogUser"
|
||||
|
||||
/// A list of all tables
|
||||
let all = [ Category; Comment; Page; Post; TagMap; Theme; ThemeAsset; WebLog; WebLogUser ]
|
||||
|
||||
/// A list of all tables with a webLogId field
|
||||
let allForWebLog = [ Comment; Post; Category; TagMap; Page; WebLogUser ]
|
||||
|
||||
|
||||
/// Shorthand for the ReQL starting point
|
||||
let r = RethinkDB.R
|
||||
|
||||
/// Verify that the web log ID matches before returning an item
|
||||
let verifyWebLog<'T> webLogId (prop : 'T -> WebLogId) (f : Net.IConnection -> Task<'T option>) =
|
||||
fun conn -> backgroundTask {
|
||||
match! f conn with Some it when (prop it) = webLogId -> return Some it | _ -> return None
|
||||
}
|
||||
|
||||
/// Get the first item from a list, or None if the list is empty
|
||||
let tryFirst<'T> (f : Net.IConnection -> Task<'T list>) =
|
||||
fun conn -> backgroundTask {
|
||||
let! results = f conn
|
||||
return results |> List.tryHead
|
||||
}
|
||||
|
||||
/// Cast a strongly-typed list to an object list
|
||||
let objList<'T> (objects : 'T list) = objects |> List.map (fun it -> it :> obj)
|
||||
|
||||
|
||||
open Microsoft.Extensions.Logging
|
||||
open MyWebLog.ViewModels
|
||||
open RethinkDb.Driver.FSharp
|
||||
|
||||
/// RethinkDB implementation of data functions for myWebLog
|
||||
type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<RethinkDbData>) =
|
||||
|
||||
/// Match theme asset IDs by their prefix (the theme ID)
|
||||
let matchAssetByThemeId themeId =
|
||||
let keyPrefix = $"^{ThemeId.toString themeId}/"
|
||||
fun (row : Ast.ReqlExpr) -> row["id"].Match keyPrefix :> obj
|
||||
|
||||
/// Ensure field indexes exist, as well as special indexes for selected tables
|
||||
let ensureIndexes table fields = backgroundTask {
|
||||
let! indexes = rethink<string list> { withTable table; indexList; result; withRetryOnce conn }
|
||||
for field in fields do
|
||||
if not (indexes |> List.contains field) then
|
||||
log.LogInformation $"Creating index {table}.{field}..."
|
||||
do! rethink { withTable table; indexCreate field; write; withRetryOnce; ignoreResult conn }
|
||||
// Post and page need index by web log ID and permalink
|
||||
if [ Table.Page; Table.Post ] |> List.contains table then
|
||||
if not (indexes |> List.contains "permalink") then
|
||||
log.LogInformation $"Creating index {table}.permalink..."
|
||||
do! rethink {
|
||||
withTable table
|
||||
indexCreate "permalink" (fun row -> r.Array (row["webLogId"], row["permalink"].Downcase ()) :> obj)
|
||||
write; withRetryOnce; ignoreResult conn
|
||||
}
|
||||
// Prior permalinks are searched when a post or page permalink do not match the current URL
|
||||
if not (indexes |> List.contains "priorPermalinks") then
|
||||
log.LogInformation $"Creating index {table}.priorPermalinks..."
|
||||
do! rethink {
|
||||
withTable table
|
||||
indexCreate "priorPermalinks" (fun row -> row["priorPermalinks"].Downcase () :> obj) [ Multi ]
|
||||
write; withRetryOnce; ignoreResult conn
|
||||
}
|
||||
// Post needs indexes by category and tag (used for counting and retrieving posts)
|
||||
if Table.Post = table then
|
||||
for idx in [ "categoryIds"; "tags" ] do
|
||||
if not (List.contains idx indexes) then
|
||||
log.LogInformation $"Creating index {table}.{idx}..."
|
||||
do! rethink {
|
||||
withTable table
|
||||
indexCreate idx [ Multi ]
|
||||
write; withRetryOnce; ignoreResult conn
|
||||
}
|
||||
// Tag mapping needs an index by web log ID and both tag and URL values
|
||||
if Table.TagMap = table then
|
||||
if not (indexes |> List.contains "webLogAndTag") then
|
||||
log.LogInformation $"Creating index {table}.webLogAndTag..."
|
||||
do! rethink {
|
||||
withTable table
|
||||
indexCreate "webLogAndTag" (fun row -> r.Array (row["webLogId"], row["tag"]) :> obj)
|
||||
write; withRetryOnce; ignoreResult conn
|
||||
}
|
||||
if not (indexes |> List.contains "webLogAndUrl") then
|
||||
log.LogInformation $"Creating index {table}.webLogAndUrl..."
|
||||
do! rethink {
|
||||
withTable table
|
||||
indexCreate "webLogAndUrl" (fun row -> r.Array (row["webLogId"], row["urlValue"]) :> obj)
|
||||
write; withRetryOnce; ignoreResult conn
|
||||
}
|
||||
// Users log on with e-mail
|
||||
if Table.WebLogUser = table && not (indexes |> List.contains "logOn") then
|
||||
log.LogInformation $"Creating index {table}.logOn..."
|
||||
do! rethink {
|
||||
withTable table
|
||||
indexCreate "logOn" (fun row -> r.Array (row["webLogId"], row["userName"]) :> obj)
|
||||
write; withRetryOnce; ignoreResult conn
|
||||
}
|
||||
}
|
||||
|
||||
/// The batch size for restoration methods
|
||||
let restoreBatchSize = 100
|
||||
|
||||
/// The connection for this instance
|
||||
member _.Conn = conn
|
||||
|
||||
interface IData with
|
||||
|
||||
member _.Category = {
|
||||
new ICategoryData with
|
||||
|
||||
member _.add cat = rethink {
|
||||
withTable Table.Category
|
||||
insert cat
|
||||
write; withRetryDefault; ignoreResult conn
|
||||
}
|
||||
|
||||
member _.countAll webLogId = rethink<int> {
|
||||
withTable Table.Category
|
||||
getAll [ webLogId ] (nameof webLogId)
|
||||
count
|
||||
result; withRetryDefault conn
|
||||
}
|
||||
|
||||
member _.countTopLevel webLogId = rethink<int> {
|
||||
withTable Table.Category
|
||||
getAll [ webLogId ] (nameof webLogId)
|
||||
filter "parentId" None
|
||||
count
|
||||
result; withRetryDefault conn
|
||||
}
|
||||
|
||||
member _.findAllForView webLogId = backgroundTask {
|
||||
let! cats = rethink<Category list> {
|
||||
withTable Table.Category
|
||||
getAll [ webLogId ] (nameof webLogId)
|
||||
orderByFunc (fun it -> it["name"].Downcase () :> obj)
|
||||
result; withRetryDefault conn
|
||||
}
|
||||
let ordered = Utils.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 = rethink<int> {
|
||||
withTable Table.Post
|
||||
getAll catIds "categoryIds"
|
||||
filter "status" Published
|
||||
distinct
|
||||
count
|
||||
result; withRetryDefault conn
|
||||
}
|
||||
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 =
|
||||
rethink<Category> {
|
||||
withTable Table.Category
|
||||
get catId
|
||||
resultOption; withRetryOptionDefault
|
||||
}
|
||||
|> verifyWebLog webLogId (fun c -> c.webLogId) <| conn
|
||||
|
||||
member _.findByWebLog webLogId = rethink<Category list> {
|
||||
withTable Table.Category
|
||||
getAll [ webLogId ] (nameof webLogId)
|
||||
result; withRetryDefault conn
|
||||
}
|
||||
|
||||
member this.delete catId webLogId = backgroundTask {
|
||||
match! this.findById catId webLogId with
|
||||
| Some _ ->
|
||||
// Delete the category off all posts where it is assigned
|
||||
do! rethink {
|
||||
withTable Table.Post
|
||||
getAll [ webLogId ] (nameof webLogId)
|
||||
filter (fun row -> row["categoryIds"].Contains catId :> obj)
|
||||
update (fun row -> r.HashMap ("categoryIds", r.Array(row["categoryIds"]).Remove catId) :> obj)
|
||||
write; withRetryDefault; ignoreResult conn
|
||||
}
|
||||
// Delete the category itself
|
||||
do! rethink {
|
||||
withTable Table.Category
|
||||
get catId
|
||||
delete
|
||||
write; withRetryDefault; ignoreResult conn
|
||||
}
|
||||
return true
|
||||
| None -> return false
|
||||
}
|
||||
|
||||
member _.restore cats = backgroundTask {
|
||||
for batch in cats |> List.chunkBySize restoreBatchSize do
|
||||
do! rethink {
|
||||
withTable Table.Category
|
||||
insert batch
|
||||
write; withRetryOnce; ignoreResult conn
|
||||
}
|
||||
}
|
||||
|
||||
member _.update cat = rethink {
|
||||
withTable Table.Category
|
||||
get cat.id
|
||||
update [ "name", cat.name :> obj
|
||||
"slug", cat.slug
|
||||
"description", cat.description
|
||||
"parentId", cat.parentId
|
||||
]
|
||||
write; withRetryDefault; ignoreResult conn
|
||||
}
|
||||
}
|
||||
|
||||
member _.Page = {
|
||||
new IPageData with
|
||||
|
||||
member _.add page = rethink {
|
||||
withTable Table.Page
|
||||
insert page
|
||||
write; withRetryDefault; ignoreResult conn
|
||||
}
|
||||
|
||||
member _.all webLogId = rethink<Page list> {
|
||||
withTable Table.Page
|
||||
getAll [ webLogId ] (nameof webLogId)
|
||||
without [ "text"; "metadata"; "revisions"; "priorPermalinks" ]
|
||||
orderByFunc (fun row -> row["title"].Downcase () :> obj)
|
||||
result; withRetryDefault conn
|
||||
}
|
||||
|
||||
member _.countAll webLogId = rethink<int> {
|
||||
withTable Table.Page
|
||||
getAll [ webLogId ] (nameof webLogId)
|
||||
count
|
||||
result; withRetryDefault conn
|
||||
}
|
||||
|
||||
member _.countListed webLogId = rethink<int> {
|
||||
withTable Table.Page
|
||||
getAll [ webLogId ] (nameof webLogId)
|
||||
filter "showInPageList" true
|
||||
count
|
||||
result; withRetryDefault conn
|
||||
}
|
||||
|
||||
member _.delete pageId webLogId = backgroundTask {
|
||||
let! result = rethink<Model.Result> {
|
||||
withTable Table.Page
|
||||
getAll [ pageId ]
|
||||
filter (fun row -> row["webLogId"].Eq webLogId :> obj)
|
||||
delete
|
||||
write; withRetryDefault conn
|
||||
}
|
||||
return result.Deleted > 0UL
|
||||
}
|
||||
|
||||
member _.findById pageId webLogId =
|
||||
rethink<Page> {
|
||||
withTable Table.Page
|
||||
get pageId
|
||||
without [ "priorPermalinks"; "revisions" ]
|
||||
resultOption; withRetryOptionDefault
|
||||
}
|
||||
|> verifyWebLog webLogId (fun it -> it.webLogId) <| conn
|
||||
|
||||
member _.findByPermalink permalink webLogId =
|
||||
rethink<Page list> {
|
||||
withTable Table.Page
|
||||
getAll [ r.Array (webLogId, permalink) ] (nameof permalink)
|
||||
without [ "priorPermalinks"; "revisions" ]
|
||||
limit 1
|
||||
result; withRetryDefault
|
||||
}
|
||||
|> tryFirst <| conn
|
||||
|
||||
member _.findCurrentPermalink permalinks webLogId = backgroundTask {
|
||||
let! result =
|
||||
(rethink<Page list> {
|
||||
withTable Table.Page
|
||||
getAll (objList permalinks) "priorPermalinks"
|
||||
filter "webLogId" webLogId
|
||||
without [ "revisions"; "text" ]
|
||||
limit 1
|
||||
result; withRetryDefault
|
||||
}
|
||||
|> tryFirst) conn
|
||||
return result |> Option.map (fun pg -> pg.permalink)
|
||||
}
|
||||
|
||||
member _.findFullById pageId webLogId =
|
||||
rethink<Page> {
|
||||
withTable Table.Page
|
||||
get pageId
|
||||
resultOption; withRetryOptionDefault
|
||||
}
|
||||
|> verifyWebLog webLogId (fun it -> it.webLogId) <| conn
|
||||
|
||||
member _.findFullByWebLog webLogId = rethink<Page> {
|
||||
withTable Table.Page
|
||||
getAll [ webLogId ] (nameof webLogId)
|
||||
resultCursor; withRetryCursorDefault; toList conn
|
||||
}
|
||||
|
||||
member _.findListed webLogId = rethink<Page list> {
|
||||
withTable Table.Page
|
||||
getAll [ webLogId ] (nameof webLogId)
|
||||
filter [ "showInPageList", true :> obj ]
|
||||
without [ "text"; "priorPermalinks"; "revisions" ]
|
||||
orderBy "title"
|
||||
result; withRetryDefault conn
|
||||
}
|
||||
|
||||
member _.findPageOfPages webLogId pageNbr = rethink<Page list> {
|
||||
withTable Table.Page
|
||||
getAll [ webLogId ] (nameof webLogId)
|
||||
without [ "metadata"; "priorPermalinks"; "revisions" ]
|
||||
orderByFunc (fun row -> row["title"].Downcase ())
|
||||
skip ((pageNbr - 1) * 25)
|
||||
limit 25
|
||||
result; withRetryDefault conn
|
||||
}
|
||||
|
||||
member _.restore pages = backgroundTask {
|
||||
for batch in pages |> List.chunkBySize restoreBatchSize do
|
||||
do! rethink {
|
||||
withTable Table.Page
|
||||
insert batch
|
||||
write; withRetryOnce; ignoreResult conn
|
||||
}
|
||||
}
|
||||
|
||||
member _.update page = rethink {
|
||||
withTable Table.Page
|
||||
get page.id
|
||||
update [
|
||||
"title", page.title :> obj
|
||||
"permalink", page.permalink
|
||||
"updatedOn", page.updatedOn
|
||||
"showInPageList", page.showInPageList
|
||||
"template", page.template
|
||||
"text", page.text
|
||||
"priorPermalinks", page.priorPermalinks
|
||||
"metadata", page.metadata
|
||||
"revisions", page.revisions
|
||||
]
|
||||
write; withRetryDefault; ignoreResult conn
|
||||
}
|
||||
|
||||
member this.updatePriorPermalinks pageId webLogId permalinks = backgroundTask {
|
||||
match! this.findById pageId webLogId with
|
||||
| Some _ ->
|
||||
do! rethink {
|
||||
withTable Table.Page
|
||||
get pageId
|
||||
update [ "priorPermalinks", permalinks :> obj ]
|
||||
write; withRetryDefault; ignoreResult conn
|
||||
}
|
||||
return true
|
||||
| None -> return false
|
||||
}
|
||||
}
|
||||
|
||||
member _.Post = {
|
||||
new IPostData with
|
||||
|
||||
member _.add post = rethink {
|
||||
withTable Table.Post
|
||||
insert post
|
||||
write; withRetryDefault; ignoreResult conn
|
||||
}
|
||||
|
||||
member _.countByStatus status webLogId = rethink<int> {
|
||||
withTable Table.Post
|
||||
getAll [ webLogId ] (nameof webLogId)
|
||||
filter "status" status
|
||||
count
|
||||
result; withRetryDefault conn
|
||||
}
|
||||
|
||||
member _.delete postId webLogId = backgroundTask {
|
||||
let! result = rethink<Model.Result> {
|
||||
withTable Table.Post
|
||||
getAll [ postId ]
|
||||
filter (fun row -> row["webLogId"].Eq webLogId :> obj)
|
||||
delete
|
||||
write; withRetryDefault conn
|
||||
}
|
||||
return result.Deleted > 0UL
|
||||
}
|
||||
|
||||
member _.findByPermalink permalink webLogId =
|
||||
rethink<Post list> {
|
||||
withTable Table.Post
|
||||
getAll [ r.Array (webLogId, permalink) ] (nameof permalink)
|
||||
without [ "priorPermalinks"; "revisions" ]
|
||||
limit 1
|
||||
result; withRetryDefault
|
||||
}
|
||||
|> tryFirst <| conn
|
||||
|
||||
member _.findFullById postId webLogId =
|
||||
rethink<Post> {
|
||||
withTable Table.Post
|
||||
get postId
|
||||
resultOption; withRetryOptionDefault
|
||||
}
|
||||
|> verifyWebLog webLogId (fun p -> p.webLogId) <| conn
|
||||
|
||||
member _.findCurrentPermalink permalinks webLogId = backgroundTask {
|
||||
let! result =
|
||||
(rethink<Post list> {
|
||||
withTable Table.Post
|
||||
getAll (objList permalinks) "priorPermalinks"
|
||||
filter "webLogId" webLogId
|
||||
without [ "revisions"; "text" ]
|
||||
limit 1
|
||||
result; withRetryDefault
|
||||
}
|
||||
|> tryFirst) conn
|
||||
return result |> Option.map (fun post -> post.permalink)
|
||||
}
|
||||
|
||||
member _.findFullByWebLog webLogId = rethink<Post> {
|
||||
withTable Table.Post
|
||||
getAll [ webLogId ] (nameof webLogId)
|
||||
resultCursor; withRetryCursorDefault; toList conn
|
||||
}
|
||||
|
||||
member _.findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = rethink<Post list> {
|
||||
withTable Table.Post
|
||||
getAll (objList categoryIds) "categoryIds"
|
||||
filter "webLogId" webLogId
|
||||
filter "status" Published
|
||||
without [ "priorPermalinks"; "revisions" ]
|
||||
distinct
|
||||
orderByDescending "publishedOn"
|
||||
skip ((pageNbr - 1) * postsPerPage)
|
||||
limit (postsPerPage + 1)
|
||||
result; withRetryDefault conn
|
||||
}
|
||||
|
||||
member _.findPageOfPosts webLogId pageNbr postsPerPage = rethink<Post list> {
|
||||
withTable Table.Post
|
||||
getAll [ webLogId ] (nameof webLogId)
|
||||
without [ "priorPermalinks"; "revisions" ]
|
||||
orderByFuncDescending (fun row -> row["publishedOn"].Default_ "updatedOn" :> obj)
|
||||
skip ((pageNbr - 1) * postsPerPage)
|
||||
limit (postsPerPage + 1)
|
||||
result; withRetryDefault conn
|
||||
}
|
||||
|
||||
member _.findPageOfPublishedPosts webLogId pageNbr postsPerPage = rethink<Post list> {
|
||||
withTable Table.Post
|
||||
getAll [ webLogId ] (nameof webLogId)
|
||||
filter "status" Published
|
||||
without [ "priorPermalinks"; "revisions" ]
|
||||
orderByDescending "publishedOn"
|
||||
skip ((pageNbr - 1) * postsPerPage)
|
||||
limit (postsPerPage + 1)
|
||||
result; withRetryDefault conn
|
||||
}
|
||||
|
||||
member _.findPageOfTaggedPosts webLogId tag pageNbr postsPerPage = rethink<Post list> {
|
||||
withTable Table.Post
|
||||
getAll [ tag ] "tags"
|
||||
filter "webLogId" webLogId
|
||||
filter "status" Published
|
||||
without [ "priorPermalinks"; "revisions" ]
|
||||
orderByDescending "publishedOn"
|
||||
skip ((pageNbr - 1) * postsPerPage)
|
||||
limit (postsPerPage + 1)
|
||||
result; withRetryDefault conn
|
||||
}
|
||||
|
||||
member _.findSurroundingPosts webLogId publishedOn = backgroundTask {
|
||||
let! older =
|
||||
rethink<Post list> {
|
||||
withTable Table.Post
|
||||
getAll [ webLogId ] (nameof webLogId)
|
||||
filter (fun row -> row["publishedOn"].Lt publishedOn :> obj)
|
||||
without [ "priorPermalinks"; "revisions" ]
|
||||
orderByDescending "publishedOn"
|
||||
limit 1
|
||||
result; withRetryDefault
|
||||
}
|
||||
|> tryFirst <| conn
|
||||
let! newer =
|
||||
rethink<Post list> {
|
||||
withTable Table.Post
|
||||
getAll [ webLogId ] (nameof webLogId)
|
||||
filter (fun row -> row["publishedOn"].Gt publishedOn :> obj)
|
||||
without [ "priorPermalinks"; "revisions" ]
|
||||
orderBy "publishedOn"
|
||||
limit 1
|
||||
result; withRetryDefault
|
||||
}
|
||||
|> tryFirst <| conn
|
||||
return older, newer
|
||||
}
|
||||
|
||||
member _.restore pages = backgroundTask {
|
||||
for batch in pages |> List.chunkBySize restoreBatchSize do
|
||||
do! rethink {
|
||||
withTable Table.Post
|
||||
insert batch
|
||||
write; withRetryOnce; ignoreResult conn
|
||||
}
|
||||
}
|
||||
|
||||
member _.update post = rethink {
|
||||
withTable Table.Post
|
||||
get post.id
|
||||
replace post
|
||||
write; withRetryDefault; ignoreResult conn
|
||||
}
|
||||
|
||||
member _.updatePriorPermalinks postId webLogId permalinks = backgroundTask {
|
||||
match! (
|
||||
rethink<Post> {
|
||||
withTable Table.Post
|
||||
get postId
|
||||
without [ "revisions"; "priorPermalinks" ]
|
||||
resultOption; withRetryOptionDefault
|
||||
}
|
||||
|> verifyWebLog webLogId (fun p -> p.webLogId)) conn with
|
||||
| Some _ ->
|
||||
do! rethink {
|
||||
withTable Table.Post
|
||||
get postId
|
||||
update [ "priorPermalinks", permalinks :> obj ]
|
||||
write; withRetryDefault; ignoreResult conn
|
||||
}
|
||||
return true
|
||||
| None -> return false
|
||||
}
|
||||
}
|
||||
|
||||
member _.TagMap = {
|
||||
new ITagMapData with
|
||||
|
||||
member _.delete tagMapId webLogId = backgroundTask {
|
||||
let! result = rethink<Model.Result> {
|
||||
withTable Table.TagMap
|
||||
getAll [ tagMapId ]
|
||||
filter (fun row -> row["webLogId"].Eq webLogId :> obj)
|
||||
delete
|
||||
write; withRetryDefault conn
|
||||
}
|
||||
return result.Deleted > 0UL
|
||||
}
|
||||
|
||||
member _.findById tagMapId webLogId =
|
||||
rethink<TagMap> {
|
||||
withTable Table.TagMap
|
||||
get tagMapId
|
||||
resultOption; withRetryOptionDefault
|
||||
}
|
||||
|> verifyWebLog webLogId (fun tm -> tm.webLogId) <| conn
|
||||
|
||||
member _.findByUrlValue urlValue webLogId =
|
||||
rethink<TagMap list> {
|
||||
withTable Table.TagMap
|
||||
getAll [ r.Array (webLogId, urlValue) ] "webLogAndUrl"
|
||||
limit 1
|
||||
result; withRetryDefault
|
||||
}
|
||||
|> tryFirst <| conn
|
||||
|
||||
member _.findByWebLog webLogId = rethink<TagMap list> {
|
||||
withTable Table.TagMap
|
||||
between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ())) [ Index "webLogAndTag" ]
|
||||
orderBy "tag"
|
||||
result; withRetryDefault conn
|
||||
}
|
||||
|
||||
member _.findMappingForTags tags webLogId = rethink<TagMap list> {
|
||||
withTable Table.TagMap
|
||||
getAll (tags |> List.map (fun tag -> r.Array (webLogId, tag) :> obj)) "webLogAndTag"
|
||||
result; withRetryDefault conn
|
||||
}
|
||||
|
||||
member _.restore tagMaps = backgroundTask {
|
||||
for batch in tagMaps |> List.chunkBySize restoreBatchSize do
|
||||
do! rethink {
|
||||
withTable Table.TagMap
|
||||
insert batch
|
||||
write; withRetryOnce; ignoreResult conn
|
||||
}
|
||||
}
|
||||
|
||||
member _.save tagMap = rethink {
|
||||
withTable Table.TagMap
|
||||
get tagMap.id
|
||||
replace tagMap
|
||||
write; withRetryDefault; ignoreResult conn
|
||||
}
|
||||
}
|
||||
|
||||
member _.Theme = {
|
||||
new IThemeData with
|
||||
|
||||
member _.all () = rethink<Theme list> {
|
||||
withTable Table.Theme
|
||||
filter (fun row -> row["id"].Ne "admin" :> obj)
|
||||
without [ "templates" ]
|
||||
orderBy "id"
|
||||
result; withRetryDefault conn
|
||||
}
|
||||
|
||||
member _.findById themeId = rethink<Theme> {
|
||||
withTable Table.Theme
|
||||
get themeId
|
||||
resultOption; withRetryOptionDefault conn
|
||||
}
|
||||
|
||||
member _.findByIdWithoutText themeId = rethink<Theme> {
|
||||
withTable Table.Theme
|
||||
get themeId
|
||||
merge (fun row -> r.HashMap ("templates", row["templates"].Without [| "text" |]))
|
||||
resultOption; withRetryOptionDefault conn
|
||||
}
|
||||
|
||||
member _.save theme = rethink {
|
||||
withTable Table.Theme
|
||||
get theme.id
|
||||
replace theme
|
||||
write; withRetryDefault; ignoreResult conn
|
||||
}
|
||||
}
|
||||
|
||||
member _.ThemeAsset = {
|
||||
new IThemeAssetData with
|
||||
|
||||
member _.all () = rethink<ThemeAsset list> {
|
||||
withTable Table.ThemeAsset
|
||||
without [ "data" ]
|
||||
result; withRetryDefault conn
|
||||
}
|
||||
|
||||
member _.deleteByTheme themeId = rethink {
|
||||
withTable Table.ThemeAsset
|
||||
filter (matchAssetByThemeId themeId)
|
||||
delete
|
||||
write; withRetryDefault; ignoreResult conn
|
||||
}
|
||||
|
||||
member _.findById assetId = rethink<ThemeAsset> {
|
||||
withTable Table.ThemeAsset
|
||||
get assetId
|
||||
resultOption; withRetryOptionDefault conn
|
||||
}
|
||||
|
||||
member _.findByTheme themeId = rethink<ThemeAsset list> {
|
||||
withTable Table.ThemeAsset
|
||||
filter (matchAssetByThemeId themeId)
|
||||
without [ "data" ]
|
||||
result; withRetryDefault conn
|
||||
}
|
||||
|
||||
member _.findByThemeWithData themeId = rethink<ThemeAsset> {
|
||||
withTable Table.ThemeAsset
|
||||
filter (matchAssetByThemeId themeId)
|
||||
resultCursor; withRetryCursorDefault; toList conn
|
||||
}
|
||||
|
||||
member _.save asset = rethink {
|
||||
withTable Table.ThemeAsset
|
||||
get asset.id
|
||||
replace asset
|
||||
write; withRetryDefault; ignoreResult conn
|
||||
}
|
||||
}
|
||||
|
||||
member _.WebLog = {
|
||||
new IWebLogData with
|
||||
|
||||
member _.add webLog = rethink {
|
||||
withTable Table.WebLog
|
||||
insert webLog
|
||||
write; withRetryOnce; ignoreResult conn
|
||||
}
|
||||
|
||||
member _.all () = rethink<WebLog list> {
|
||||
withTable Table.WebLog
|
||||
result; withRetryDefault conn
|
||||
}
|
||||
|
||||
member _.delete webLogId = backgroundTask {
|
||||
for table in Table.allForWebLog do
|
||||
do! rethink {
|
||||
withTable table
|
||||
getAll [ webLogId ] (nameof webLogId)
|
||||
delete
|
||||
write; withRetryOnce; ignoreResult conn
|
||||
}
|
||||
do! rethink {
|
||||
withTable Table.WebLog
|
||||
get webLogId
|
||||
delete
|
||||
write; withRetryOnce; ignoreResult conn
|
||||
}
|
||||
}
|
||||
|
||||
member _.findByHost url =
|
||||
rethink<WebLog list> {
|
||||
withTable Table.WebLog
|
||||
getAll [ url ] "urlBase"
|
||||
limit 1
|
||||
result; withRetryDefault
|
||||
}
|
||||
|> tryFirst <| conn
|
||||
|
||||
member _.findById webLogId = rethink<WebLog> {
|
||||
withTable Table.WebLog
|
||||
get webLogId
|
||||
resultOption; withRetryOptionDefault conn
|
||||
}
|
||||
|
||||
member _.updateRssOptions webLog = rethink {
|
||||
withTable Table.WebLog
|
||||
get webLog.id
|
||||
update [ "rss", webLog.rss :> obj ]
|
||||
write; withRetryDefault; ignoreResult conn
|
||||
}
|
||||
|
||||
member _.updateSettings webLog = rethink {
|
||||
withTable Table.WebLog
|
||||
get webLog.id
|
||||
update [
|
||||
"name", webLog.name :> obj
|
||||
"subtitle", webLog.subtitle
|
||||
"defaultPage", webLog.defaultPage
|
||||
"postsPerPage", webLog.postsPerPage
|
||||
"timeZone", webLog.timeZone
|
||||
"themePath", webLog.themePath
|
||||
"autoHtmx", webLog.autoHtmx
|
||||
]
|
||||
write; withRetryDefault; ignoreResult conn
|
||||
}
|
||||
}
|
||||
|
||||
member _.WebLogUser = {
|
||||
new IWebLogUserData with
|
||||
|
||||
member _.add user = rethink {
|
||||
withTable Table.WebLogUser
|
||||
insert user
|
||||
write; withRetryDefault; ignoreResult conn
|
||||
}
|
||||
|
||||
member _.findByEmail email webLogId =
|
||||
rethink<WebLogUser list> {
|
||||
withTable Table.WebLogUser
|
||||
getAll [ r.Array (webLogId, email) ] "logOn"
|
||||
limit 1
|
||||
result; withRetryDefault
|
||||
}
|
||||
|> tryFirst <| conn
|
||||
|
||||
member _.findById userId webLogId =
|
||||
rethink<WebLogUser> {
|
||||
withTable Table.WebLogUser
|
||||
get userId
|
||||
resultOption; withRetryOptionDefault
|
||||
}
|
||||
|> verifyWebLog webLogId (fun u -> u.webLogId) <| conn
|
||||
|
||||
member _.findByWebLog webLogId = rethink<WebLogUser list> {
|
||||
withTable Table.WebLogUser
|
||||
getAll [ webLogId ] (nameof webLogId)
|
||||
result; withRetryDefault conn
|
||||
}
|
||||
|
||||
member _.findNames webLogId userIds = backgroundTask {
|
||||
let! users = rethink<WebLogUser list> {
|
||||
withTable Table.WebLogUser
|
||||
getAll (objList userIds)
|
||||
filter "webLogId" webLogId
|
||||
result; withRetryDefault conn
|
||||
}
|
||||
return
|
||||
users
|
||||
|> List.map (fun u -> { name = WebLogUserId.toString u.id; value = WebLogUser.displayName u })
|
||||
}
|
||||
|
||||
member _.restore users = backgroundTask {
|
||||
for batch in users |> List.chunkBySize restoreBatchSize do
|
||||
do! rethink {
|
||||
withTable Table.WebLogUser
|
||||
insert batch
|
||||
write; withRetryOnce; ignoreResult conn
|
||||
}
|
||||
}
|
||||
|
||||
member _.update user = rethink {
|
||||
withTable Table.WebLogUser
|
||||
get user.id
|
||||
update [
|
||||
"firstName", user.firstName :> obj
|
||||
"lastName", user.lastName
|
||||
"preferredName", user.preferredName
|
||||
"passwordHash", user.passwordHash
|
||||
"salt", user.salt
|
||||
]
|
||||
write; withRetryDefault; ignoreResult conn
|
||||
}
|
||||
}
|
||||
|
||||
member _.startUp () = backgroundTask {
|
||||
let! dbs = rethink<string list> { dbList; result; withRetryOnce conn }
|
||||
if not (dbs |> List.contains config.Database) then
|
||||
log.LogInformation $"Creating database {config.Database}..."
|
||||
do! rethink { dbCreate config.Database; write; withRetryOnce; ignoreResult conn }
|
||||
|
||||
let! tables = rethink<string list> { tableList; result; withRetryOnce conn }
|
||||
for tbl in Table.all do
|
||||
if not (tables |> List.contains tbl) then
|
||||
log.LogInformation $"Creating table {tbl}..."
|
||||
do! rethink { tableCreate tbl; write; withRetryOnce; ignoreResult conn }
|
||||
|
||||
do! ensureIndexes Table.Category [ "webLogId" ]
|
||||
do! ensureIndexes Table.Comment [ "postId" ]
|
||||
do! ensureIndexes Table.Page [ "webLogId"; "authorId" ]
|
||||
do! ensureIndexes Table.Post [ "webLogId"; "authorId" ]
|
||||
do! ensureIndexes Table.TagMap []
|
||||
do! ensureIndexes Table.WebLog [ "urlBase" ]
|
||||
do! ensureIndexes Table.WebLogUser [ "webLogId" ]
|
||||
}
|
||||
2017
src/MyWebLog.Data/SQLiteData.fs
Normal file
2017
src/MyWebLog.Data/SQLiteData.fs
Normal file
File diff suppressed because it is too large
Load Diff
22
src/MyWebLog.Data/Utils.fs
Normal file
22
src/MyWebLog.Data/Utils.fs
Normal file
@@ -0,0 +1,22 @@
|
||||
/// Utility functions for manipulating data
|
||||
[<RequireQualifiedAccess>]
|
||||
module internal MyWebLog.Data.Utils
|
||||
|
||||
open MyWebLog
|
||||
open MyWebLog.ViewModels
|
||||
|
||||
/// Create a category hierarchy from the given list of categories
|
||||
let rec orderByHierarchy (cats : Category list) parentId slugBase parentNames = seq {
|
||||
for cat in cats |> List.filter (fun c -> c.parentId = parentId) do
|
||||
let fullSlug = (match slugBase with Some it -> $"{it}/" | None -> "") + cat.slug
|
||||
{ id = CategoryId.toString cat.id
|
||||
slug = fullSlug
|
||||
name = cat.name
|
||||
description = cat.description
|
||||
parentNames = Array.ofList parentNames
|
||||
// Post counts are filled on a second pass
|
||||
postCount = 0
|
||||
}
|
||||
yield! orderByHierarchy cats (Some cat.id) (Some fullSlug) ([ cat.name ] |> List.append parentNames)
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user