/// Helper functions for the PostgreSQL data implementation [] module MyWebLog.Data.Postgres.PostgresHelpers /// The table names used in the PostgreSQL implementation [] module Table = /// Categories [] let Category = "category" /// Database Version [] let DbVersion = "db_version" /// Pages [] let Page = "page" /// Page Revisions [] let PageRevision = "page_revision" /// Posts [] let Post = "post" /// Post Comments [] let PostComment = "post_comment" /// Post Revisions [] let PostRevision = "post_revision" /// Tag/URL Mappings [] let TagMap = "tag_map" /// Themes [] let Theme = "theme" /// Theme Assets [] let ThemeAsset = "theme_asset" /// Uploads [] let Upload = "upload" /// Web Logs [] let WebLog = "web_log" /// Users [] let WebLogUser = "web_log_user" open System open System.Threading.Tasks open BitBadger.Documents open BitBadger.Documents.Postgres open MyWebLog open MyWebLog.Data open NodaTime open Npgsql open Npgsql.FSharp /// Create a SQL parameter for the web log ID let webLogIdParam (webLogId: WebLogId) = "@webLogId", Sql.string (string webLogId) /// Create an anonymous record with the given web log ID let webLogDoc (webLogId: WebLogId) = {| WebLogId = webLogId |} /// Create a parameter for a web log document-contains query let webLogContains webLogId = jsonParam "@criteria" (webLogDoc webLogId) /// A SQL string to select data from a table with the given JSON document contains criteria let selectWithCriteria tableName = Query.byContains (Query.find tableName) /// Get the first result of the given query let tryHead<'T> (query: Task<'T list>) = backgroundTask { let! results = query return List.tryHead results } /// Create a parameter for a non-standard type let typedParam<'T> name (it: 'T) = $"@%s{name}", Sql.parameter (NpgsqlParameter($"@{name}", it)) /// Create a parameter for a possibly-missing non-standard type let optParam<'T> name (it: 'T option) = let p = NpgsqlParameter($"@%s{name}", if Option.isSome it then box it.Value else DBNull.Value) p.ParameterName, Sql.parameter p /// Mapping functions for SQL queries module Map = /// Create a permalink from the current row let toPermalink (row: RowReader) = Permalink (row.string "permalink") /// Create a revision from the current row let toRevision (row: RowReader) : Revision = { AsOf = row.fieldValue "as_of" Text = row.string "revision_text" |> MarkupText.Parse } /// Create a theme asset from the current row let toThemeAsset includeData (row: RowReader) : ThemeAsset = { Id = ThemeAssetId (ThemeId (row.string "theme_id"), row.string "path") UpdatedOn = row.fieldValue "updated_on" Data = if includeData then row.bytea "data" else [||] } /// Create an uploaded file from the current row let toUpload includeData (row: RowReader) : Upload = { Id = row.string "id" |> UploadId WebLogId = row.string "web_log_id" |> WebLogId Path = row.string "path" |> Permalink UpdatedOn = row.fieldValue "updated_on" Data = if includeData then row.bytea "data" else [||] } /// Document manipulation functions module Document = /// Determine whether a document exists with the given key for the given web log let existsByWebLog<'TKey> table (key: 'TKey) webLogId = Custom.scalar $"""SELECT EXISTS ( SELECT 1 FROM %s{table} WHERE {Query.whereById "@id"} AND {Query.whereDataContains "@criteria"} ) AS it""" [ "@id", Sql.string (string key); webLogContains webLogId ] toExists /// Find a document by its ID for the given web log let findByIdAndWebLog<'TKey, 'TDoc> table (key: 'TKey) webLogId = Custom.single $"""{Query.find table} WHERE {Query.whereById "@id"} AND {Query.whereDataContains "@criteria"}""" [ "@id", Sql.string (string key); webLogContains webLogId ] fromData<'TDoc> /// Functions to support revisions module Revisions = /// Find all revisions for the given entity let findByEntityId<'TKey> revTable entityTable (key: 'TKey) = Custom.list $"SELECT as_of, revision_text FROM %s{revTable} WHERE %s{entityTable}_id = @id ORDER BY as_of DESC" [ "@id", Sql.string (string key) ] Map.toRevision /// Find all revisions for all posts for the given web log let findByWebLog<'TKey> revTable entityTable (keyFunc: string -> 'TKey) webLogId = Custom.list $"""SELECT pr.* FROM %s{revTable} pr INNER JOIN %s{entityTable} p ON p.data->>'{nameof Post.Empty.Id}' = pr.{entityTable}_id WHERE p.{Query.whereDataContains "@criteria"} ORDER BY as_of DESC""" [ webLogContains webLogId ] (fun row -> keyFunc (row.string $"{entityTable}_id"), Map.toRevision row) /// Parameters for a revision INSERT statement let revParams<'TKey> (key: 'TKey) rev = [ typedParam "asOf" rev.AsOf "@id", Sql.string (string key) "@text", Sql.string (string rev.Text) ] /// The SQL statement to insert a revision let insertSql table = $"INSERT INTO %s{table} VALUES (@id, @asOf, @text)" /// Update a page's revisions let update<'TKey> revTable entityTable (key: 'TKey) oldRevs newRevs = backgroundTask { let toDelete, toAdd = Utils.diffRevisions oldRevs newRevs if not (List.isEmpty toDelete) || not (List.isEmpty toAdd) then let! _ = Configuration.dataSource () |> Sql.fromDataSource |> Sql.executeTransactionAsync [ if not (List.isEmpty toDelete) then $"DELETE FROM %s{revTable} WHERE %s{entityTable}_id = @id AND as_of = @asOf", toDelete |> List.map (fun it -> [ "@id", Sql.string (string key) typedParam "asOf" it.AsOf ]) if not (List.isEmpty toAdd) then insertSql revTable, toAdd |> List.map (revParams key) ] () }