Compare commits
7 Commits
v2.0-beta0
...
v2.0-beta0
| Author | SHA1 | Date | |
|---|---|---|---|
| 3203f1b2ee | |||
| 7203fa5a38 | |||
| 16603bbcaf | |||
| 80c65bcad6 | |||
| 9fbb1bb14d | |||
| 707b67c630 | |||
| dfb0ff3b9c |
3
.gitignore
vendored
3
.gitignore
vendored
@@ -260,4 +260,5 @@ paket-files/
|
||||
src/MyWebLog/wwwroot/img/daniel-j-summers
|
||||
src/MyWebLog/wwwroot/img/bit-badger
|
||||
|
||||
.ionide
|
||||
.ionide
|
||||
src/MyWebLog/appsettings.Production.json
|
||||
|
||||
@@ -65,6 +65,13 @@ module Json =
|
||||
override _.ReadJson (reader : JsonReader, _ : Type, _ : PageId, _ : bool, _ : JsonSerializer) =
|
||||
(string >> PageId) reader.Value
|
||||
|
||||
type PodcastMediumConverter () =
|
||||
inherit JsonConverter<PodcastMedium> ()
|
||||
override _.WriteJson (writer : JsonWriter, value : PodcastMedium, _ : JsonSerializer) =
|
||||
writer.WriteValue (PodcastMedium.toString value)
|
||||
override _.ReadJson (reader : JsonReader, _ : Type, _ : PodcastMedium, _ : bool, _ : JsonSerializer) =
|
||||
(string >> PodcastMedium.parse) reader.Value
|
||||
|
||||
type PostIdConverter () =
|
||||
inherit JsonConverter<PostId> ()
|
||||
override _.WriteJson (writer : JsonWriter, value : PostId, _ : JsonSerializer) =
|
||||
@@ -121,6 +128,7 @@ module Json =
|
||||
MarkupTextConverter ()
|
||||
PermalinkConverter ()
|
||||
PageIdConverter ()
|
||||
PodcastMediumConverter ()
|
||||
PostIdConverter ()
|
||||
TagMapIdConverter ()
|
||||
ThemeAssetIdConverter ()
|
||||
|
||||
@@ -25,6 +25,14 @@
|
||||
<Compile Include="Interfaces.fs" />
|
||||
<Compile Include="Utils.fs" />
|
||||
<Compile Include="RethinkDbData.fs" />
|
||||
<Compile Include="SQLite\Helpers.fs" />
|
||||
<Compile Include="SQLite\SQLiteCategoryData.fs" />
|
||||
<Compile Include="SQLite\SQLitePageData.fs" />
|
||||
<Compile Include="SQLite\SQLitePostData.fs" />
|
||||
<Compile Include="SQLite\SQLiteTagMapData.fs" />
|
||||
<Compile Include="SQLite\SQLiteThemeData.fs" />
|
||||
<Compile Include="SQLite\SQLiteWebLogData.fs" />
|
||||
<Compile Include="SQLite\SQLiteWebLogUserData.fs" />
|
||||
<Compile Include="SQLiteData.fs" />
|
||||
</ItemGroup>
|
||||
|
||||
|
||||
@@ -41,9 +41,6 @@ module private RethinkHelpers =
|
||||
|
||||
/// 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
|
||||
@@ -743,19 +740,42 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
|
||||
}
|
||||
|
||||
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
|
||||
}
|
||||
// Comments should be deleted by post IDs
|
||||
let! thePostIds = rethink<{| id : string |} list> {
|
||||
withTable Table.Post
|
||||
getAll [ webLogId ] (nameof webLogId)
|
||||
pluck [ "id" ]
|
||||
result; withRetryOnce conn
|
||||
}
|
||||
if not (List.isEmpty thePostIds) then
|
||||
let postIds = thePostIds |> List.map (fun it -> it.id :> obj)
|
||||
do! rethink {
|
||||
withTable Table.Comment
|
||||
getAll postIds "postId"
|
||||
delete
|
||||
write; withRetryOnce; ignoreResult conn
|
||||
}
|
||||
// Tag mappings do not have a straightforward webLogId index
|
||||
do! rethink {
|
||||
withTable Table.TagMap
|
||||
between (r.Array (webLogId, r.Minval ())) (r.Array (webLogId, r.Maxval ()))
|
||||
[ Index "webLogAndTag" ]
|
||||
delete
|
||||
write; withRetryOnce; ignoreResult conn
|
||||
}
|
||||
for table in [ Table.Post; Table.Category; Table.Page; Table.WebLogUser ] 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 =
|
||||
|
||||
292
src/MyWebLog.Data/SQLite/Helpers.fs
Normal file
292
src/MyWebLog.Data/SQLite/Helpers.fs
Normal file
@@ -0,0 +1,292 @@
|
||||
/// Helper functions for the SQLite data implementation
|
||||
[<AutoOpen>]
|
||||
module MyWebLog.Data.SQLite.Helpers
|
||||
|
||||
open System
|
||||
open Microsoft.Data.Sqlite
|
||||
open MyWebLog
|
||||
|
||||
/// Run a command that returns a count
|
||||
let count (cmd : SqliteCommand) = backgroundTask {
|
||||
let! it = cmd.ExecuteScalarAsync ()
|
||||
return int (it :?> int64)
|
||||
}
|
||||
|
||||
/// 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
|
||||
|
||||
/// 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}")
|
||||
|
||||
/// 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 }
|
||||
|> List.ofSeq
|
||||
|
||||
/// Verify that the web log ID matches before returning an item
|
||||
let verifyWebLog<'T> webLogId (prop : 'T -> WebLogId) (it : SqliteDataReader -> 'T) (rdr : SqliteDataReader) =
|
||||
if rdr.Read () then
|
||||
let item = it rdr
|
||||
if prop item = webLogId then Some item else None
|
||||
else
|
||||
None
|
||||
|
||||
/// Execute a command that returns no data
|
||||
let write (cmd : SqliteCommand) = backgroundTask {
|
||||
let! _ = cmd.ExecuteNonQueryAsync ()
|
||||
()
|
||||
}
|
||||
|
||||
/// Functions to map domain items from a data reader
|
||||
module Map =
|
||||
|
||||
open System.IO
|
||||
|
||||
/// Get a boolean value from a data reader
|
||||
let getBoolean col (rdr : SqliteDataReader) = rdr.GetBoolean (rdr.GetOrdinal col)
|
||||
|
||||
/// Get a date/time value from a data reader
|
||||
let getDateTime col (rdr : SqliteDataReader) = rdr.GetDateTime (rdr.GetOrdinal col)
|
||||
|
||||
/// Get a Guid value from a data reader
|
||||
let getGuid col (rdr : SqliteDataReader) = rdr.GetGuid (rdr.GetOrdinal col)
|
||||
|
||||
/// Get an int value from a data reader
|
||||
let getInt col (rdr : SqliteDataReader) = rdr.GetInt32 (rdr.GetOrdinal col)
|
||||
|
||||
/// Get a long (64-bit int) value from a data reader
|
||||
let getLong col (rdr : SqliteDataReader) = rdr.GetInt64 (rdr.GetOrdinal col)
|
||||
|
||||
/// Get a BLOB stream value from a data reader
|
||||
let getStream col (rdr : SqliteDataReader) = rdr.GetStream (rdr.GetOrdinal col)
|
||||
|
||||
/// Get a string value from a data reader
|
||||
let getString col (rdr : SqliteDataReader) = rdr.GetString (rdr.GetOrdinal col)
|
||||
|
||||
/// Get a timespan value from a data reader
|
||||
let getTimeSpan col (rdr : SqliteDataReader) = rdr.GetTimeSpan (rdr.GetOrdinal col)
|
||||
|
||||
/// Get a possibly null boolean value from a data reader
|
||||
let tryBoolean col (rdr : SqliteDataReader) =
|
||||
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getBoolean col rdr)
|
||||
|
||||
/// 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 Guid value from a data reader
|
||||
let tryGuid col (rdr : SqliteDataReader) =
|
||||
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getGuid col rdr)
|
||||
|
||||
/// Get a possibly null int value from a data reader
|
||||
let tryInt col (rdr : SqliteDataReader) =
|
||||
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getInt col rdr)
|
||||
|
||||
/// Get a possibly null string value from a data reader
|
||||
let tryString col (rdr : SqliteDataReader) =
|
||||
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getString col rdr)
|
||||
|
||||
/// Get a possibly null timespan value from a data reader
|
||||
let tryTimeSpan col (rdr : SqliteDataReader) =
|
||||
if rdr.IsDBNull (rdr.GetOrdinal col) then None else Some (getTimeSpan 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 = 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 custom feed from the current row in the given data reader
|
||||
let toCustomFeed (rdr : SqliteDataReader) : CustomFeed =
|
||||
{ id = CustomFeedId (getString "id" rdr)
|
||||
source = CustomFeedSource.parse (getString "source" rdr)
|
||||
path = Permalink (getString "path" rdr)
|
||||
podcast =
|
||||
if rdr.IsDBNull (rdr.GetOrdinal "title") then
|
||||
None
|
||||
else
|
||||
Some {
|
||||
title = getString "title" rdr
|
||||
subtitle = tryString "subtitle" rdr
|
||||
itemsInFeed = getInt "items_in_feed" rdr
|
||||
summary = getString "summary" rdr
|
||||
displayedAuthor = getString "displayed_author" rdr
|
||||
email = getString "email" rdr
|
||||
imageUrl = Permalink (getString "image_url" rdr)
|
||||
iTunesCategory = getString "itunes_category" rdr
|
||||
iTunesSubcategory = tryString "itunes_subcategory" rdr
|
||||
explicit = ExplicitRating.parse (getString "explicit" rdr)
|
||||
defaultMediaType = tryString "default_media_type" rdr
|
||||
mediaBaseUrl = tryString "media_base_url" rdr
|
||||
guid = tryGuid "guid" rdr
|
||||
fundingUrl = tryString "funding_url" rdr
|
||||
fundingText = tryString "funding_text" rdr
|
||||
medium = tryString "medium" rdr |> Option.map PodcastMedium.parse
|
||||
}
|
||||
}
|
||||
|
||||
/// Create a meta item from the current row in the given data reader
|
||||
let toMetaItem (rdr : SqliteDataReader) : MetaItem =
|
||||
{ name = getString "name" rdr
|
||||
value = getString "value" rdr
|
||||
}
|
||||
|
||||
/// Create a permalink from the current row in the given data reader
|
||||
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 "id" rdr)
|
||||
webLogId = WebLogId (getString "web_log_id" rdr)
|
||||
authorId = WebLogUserId (getString "author_id" rdr)
|
||||
title = getString "title" rdr
|
||||
permalink = toPermalink rdr
|
||||
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 "post_text" rdr
|
||||
episode =
|
||||
match tryString "media" rdr with
|
||||
| Some media ->
|
||||
Some {
|
||||
media = media
|
||||
length = getLong "length" rdr
|
||||
duration = tryTimeSpan "duration" rdr
|
||||
mediaType = tryString "media_type" rdr
|
||||
imageUrl = tryString "image_url" rdr
|
||||
subtitle = tryString "subtitle" rdr
|
||||
explicit = tryString "explicit" rdr |> Option.map ExplicitRating.parse
|
||||
chapterFile = tryString "chapter_file" rdr
|
||||
chapterType = tryString "chapter_type" rdr
|
||||
transcriptUrl = tryString "transcript_url" rdr
|
||||
transcriptType = tryString "transcript_type" rdr
|
||||
transcriptLang = tryString "transcript_lang" rdr
|
||||
transcriptCaptions = tryBoolean "transcript_captions" rdr
|
||||
seasonNumber = tryInt "season_number" rdr
|
||||
seasonDescription = tryString "season_description" rdr
|
||||
episodeNumber = tryString "episode_number" rdr |> Option.map Double.Parse
|
||||
episodeDescription = tryString "episode_description" rdr
|
||||
}
|
||||
| None -> None
|
||||
}
|
||||
|
||||
/// Create a revision from the current row in the given data reader
|
||||
let toRevision (rdr : SqliteDataReader) : Revision =
|
||||
{ asOf = getDateTime "as_of" rdr
|
||||
text = MarkupText.parse (getString "revision_text" rdr)
|
||||
}
|
||||
|
||||
/// Create a tag mapping from the current row in the given data reader
|
||||
let toTagMap (rdr : SqliteDataReader) : TagMap =
|
||||
{ id = TagMapId (getString "id" rdr)
|
||||
webLogId = WebLogId (getString "web_log_id" rdr)
|
||||
tag = getString "tag" rdr
|
||||
urlValue = getString "url_value" rdr
|
||||
}
|
||||
|
||||
/// Create a theme from the current row in the given data reader (excludes templates)
|
||||
let toTheme (rdr : SqliteDataReader) : Theme =
|
||||
{ Theme.empty with
|
||||
id = ThemeId (getString "id" rdr)
|
||||
name = getString "name" rdr
|
||||
version = getString "version" rdr
|
||||
}
|
||||
|
||||
/// Create a theme asset from the current row in the given data reader
|
||||
let toThemeAsset includeData (rdr : SqliteDataReader) : ThemeAsset =
|
||||
let assetData =
|
||||
if includeData then
|
||||
use dataStream = new MemoryStream ()
|
||||
use blobStream = getStream "data" rdr
|
||||
blobStream.CopyTo dataStream
|
||||
dataStream.ToArray ()
|
||||
else
|
||||
[||]
|
||||
{ id = ThemeAssetId (ThemeId (getString "theme_id" rdr), getString "path" rdr)
|
||||
updatedOn = getDateTime "updated_on" rdr
|
||||
data = assetData
|
||||
}
|
||||
|
||||
/// Create a theme template from the current row in the given data reader
|
||||
let toThemeTemplate (rdr : SqliteDataReader) : ThemeTemplate =
|
||||
{ name = getString "name" rdr
|
||||
text = getString "template" rdr
|
||||
}
|
||||
|
||||
/// Create a web log from the current row in the given data reader
|
||||
let toWebLog (rdr : SqliteDataReader) : WebLog =
|
||||
{ id = WebLogId (getString "id" rdr)
|
||||
name = getString "name" rdr
|
||||
subtitle = tryString "subtitle" rdr
|
||||
defaultPage = getString "default_page" rdr
|
||||
postsPerPage = getInt "posts_per_page" rdr
|
||||
themePath = getString "theme_id" rdr
|
||||
urlBase = getString "url_base" rdr
|
||||
timeZone = getString "time_zone" rdr
|
||||
autoHtmx = getBoolean "auto_htmx" rdr
|
||||
rss = {
|
||||
feedEnabled = getBoolean "feed_enabled" rdr
|
||||
feedName = getString "feed_name" rdr
|
||||
itemsInFeed = tryInt "items_in_feed" rdr
|
||||
categoryEnabled = getBoolean "category_enabled" rdr
|
||||
tagEnabled = getBoolean "tag_enabled" rdr
|
||||
copyright = tryString "copyright" rdr
|
||||
customFeeds = []
|
||||
}
|
||||
}
|
||||
|
||||
/// Create a web log user from the current row in the given data reader
|
||||
let toWebLogUser (rdr : SqliteDataReader) : WebLogUser =
|
||||
{ id = WebLogUserId (getString "id" rdr)
|
||||
webLogId = WebLogId (getString "web_log_id" rdr)
|
||||
userName = getString "user_name" rdr
|
||||
firstName = getString "first_name" rdr
|
||||
lastName = getString "last_name" rdr
|
||||
preferredName = getString "preferred_name" rdr
|
||||
passwordHash = getString "password_hash" rdr
|
||||
salt = getGuid "salt" rdr
|
||||
url = tryString "url" rdr
|
||||
authorizationLevel = AuthorizationLevel.parse (getString "authorization_level" rdr)
|
||||
}
|
||||
|
||||
/// Add a possibly-missing parameter, substituting null for None
|
||||
let maybe<'T> (it : 'T option) : obj = match it with Some x -> x :> obj | None -> DBNull.Value
|
||||
|
||||
/// Add a web log ID parameter
|
||||
let addWebLogId (cmd : SqliteCommand) webLogId =
|
||||
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore
|
||||
174
src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs
Normal file
174
src/MyWebLog.Data/SQLite/SQLiteCategoryData.fs
Normal file
@@ -0,0 +1,174 @@
|
||||
namespace MyWebLog.Data.SQLite
|
||||
|
||||
open System.Threading.Tasks
|
||||
open Microsoft.Data.Sqlite
|
||||
open MyWebLog
|
||||
open MyWebLog.Data
|
||||
|
||||
/// SQLite myWebLog category data implementation
|
||||
type SQLiteCategoryData (conn : SqliteConnection) =
|
||||
|
||||
/// Add parameters for category INSERT or UPDATE statements
|
||||
let addCategoryParameters (cmd : SqliteCommand) (cat : Category) =
|
||||
[ 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", maybe cat.description)
|
||||
cmd.Parameters.AddWithValue ("@parentId", maybe (cat.parentId |> Option.map CategoryId.toString))
|
||||
] |> ignore
|
||||
|
||||
/// Add a category
|
||||
let add cat = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""INSERT INTO category (
|
||||
id, web_log_id, name, slug, description, parent_id
|
||||
) VALUES (
|
||||
@id, @webLogId, @name, @slug, @description, @parentId
|
||||
)"""
|
||||
addCategoryParameters cmd cat
|
||||
let! _ = cmd.ExecuteNonQueryAsync ()
|
||||
()
|
||||
}
|
||||
|
||||
/// Count all categories for the given web log
|
||||
let countAll webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT COUNT(id) FROM category WHERE web_log_id = @webLogId"
|
||||
addWebLogId cmd webLogId
|
||||
return! count cmd
|
||||
}
|
||||
|
||||
/// Count all top-level categories for the given web log
|
||||
let countTopLevel webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"SELECT COUNT(id) FROM category WHERE web_log_id = @webLogId AND parent_id IS NULL"
|
||||
addWebLogId cmd webLogId
|
||||
return! count cmd
|
||||
}
|
||||
|
||||
/// Retrieve all categories for the given web log in a DotLiquid-friendly format
|
||||
let findAllForView webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM category WHERE web_log_id = @webLogId"
|
||||
addWebLogId cmd webLogId
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
let cats =
|
||||
seq {
|
||||
while rdr.Read () do
|
||||
Map.toCategory rdr
|
||||
}
|
||||
|> Seq.sortBy (fun cat -> cat.name.ToLowerInvariant ())
|
||||
|> List.ofSeq
|
||||
do! rdr.CloseAsync ()
|
||||
let ordered = Utils.orderByHierarchy cats None None []
|
||||
let! counts =
|
||||
ordered
|
||||
|> Seq.map (fun it -> backgroundTask {
|
||||
// Parent category post counts include posts in subcategories
|
||||
cmd.Parameters.Clear ()
|
||||
addWebLogId cmd webLogId
|
||||
cmd.CommandText <-
|
||||
"""SELECT COUNT(DISTINCT p.id)
|
||||
FROM post p
|
||||
INNER JOIN post_category pc ON pc.post_id = p.id
|
||||
WHERE p.web_log_id = @webLogId
|
||||
AND p.status = 'Published'
|
||||
AND pc.category_id IN ("""
|
||||
ordered
|
||||
|> Seq.filter (fun cat -> cat.parentNames |> Array.contains it.name)
|
||||
|> Seq.map (fun cat -> cat.id)
|
||||
|> Seq.append (Seq.singleton it.id)
|
||||
|> Seq.iteri (fun idx item ->
|
||||
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
|
||||
cmd.CommandText <- $"{cmd.CommandText}@catId{idx}"
|
||||
cmd.Parameters.AddWithValue ($"@catId{idx}", item) |> ignore)
|
||||
cmd.CommandText <- $"{cmd.CommandText})"
|
||||
let! postCount = count cmd
|
||||
return it.id, postCount
|
||||
})
|
||||
|> 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
|
||||
}
|
||||
/// Find a category by its ID for the given web log
|
||||
let findById catId webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM category WHERE id = @id"
|
||||
cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId) |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return Helpers.verifyWebLog<Category> webLogId (fun c -> c.webLogId) Map.toCategory rdr
|
||||
}
|
||||
|
||||
/// Find all categories for the given web log
|
||||
let findByWebLog webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM category WHERE web_log_id = @webLogId"
|
||||
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return toList Map.toCategory rdr
|
||||
}
|
||||
|
||||
/// Delete a category
|
||||
let delete catId webLogId = backgroundTask {
|
||||
match! findById catId webLogId with
|
||||
| Some _ ->
|
||||
use cmd = conn.CreateCommand ()
|
||||
// Delete the category off all posts where it is assigned
|
||||
cmd.CommandText <-
|
||||
"""DELETE FROM post_category
|
||||
WHERE category_id = @id
|
||||
AND post_id IN (SELECT id FROM post WHERE web_log_id = @webLogId)"""
|
||||
let catIdParameter = cmd.Parameters.AddWithValue ("@id", CategoryId.toString catId)
|
||||
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId) |> ignore
|
||||
do! write cmd
|
||||
// Delete the category itself
|
||||
cmd.CommandText <- "DELETE FROM category WHERE id = @id"
|
||||
cmd.Parameters.Clear ()
|
||||
cmd.Parameters.Add catIdParameter |> ignore
|
||||
do! write cmd
|
||||
return true
|
||||
| None -> return false
|
||||
}
|
||||
|
||||
/// Restore categories from a backup
|
||||
let restore cats = backgroundTask {
|
||||
for cat in cats do
|
||||
do! add cat
|
||||
}
|
||||
|
||||
/// Update a category
|
||||
let update cat = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""UPDATE category
|
||||
SET name = @name,
|
||||
slug = @slug,
|
||||
description = @description,
|
||||
parent_id = @parentId
|
||||
WHERE id = @id
|
||||
AND web_log_id = @webLogId"""
|
||||
addCategoryParameters cmd cat
|
||||
do! write cmd
|
||||
}
|
||||
|
||||
interface ICategoryData with
|
||||
member _.add cat = add cat
|
||||
member _.countAll webLogId = countAll webLogId
|
||||
member _.countTopLevel webLogId = countTopLevel webLogId
|
||||
member _.findAllForView webLogId = findAllForView webLogId
|
||||
member _.findById catId webLogId = findById catId webLogId
|
||||
member _.findByWebLog webLogId = findByWebLog webLogId
|
||||
member _.delete catId webLogId = delete catId webLogId
|
||||
member _.restore cats = restore cats
|
||||
member _.update cat = update cat
|
||||
366
src/MyWebLog.Data/SQLite/SQLitePageData.fs
Normal file
366
src/MyWebLog.Data/SQLite/SQLitePageData.fs
Normal file
@@ -0,0 +1,366 @@
|
||||
namespace MyWebLog.Data.SQLite
|
||||
|
||||
open System.Threading.Tasks
|
||||
open Microsoft.Data.Sqlite
|
||||
open MyWebLog
|
||||
open MyWebLog.Data
|
||||
|
||||
/// SQLite myWebLog page data implementation
|
||||
type SQLitePageData (conn : SqliteConnection) =
|
||||
|
||||
// SUPPORT FUNCTIONS
|
||||
|
||||
/// Add parameters for page INSERT or UPDATE statements
|
||||
let addPageParameters (cmd : SqliteCommand) (page : Page) =
|
||||
[ cmd.Parameters.AddWithValue ("@id", PageId.toString page.id)
|
||||
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString page.webLogId)
|
||||
cmd.Parameters.AddWithValue ("@authorId", WebLogUserId.toString page.authorId)
|
||||
cmd.Parameters.AddWithValue ("@title", page.title)
|
||||
cmd.Parameters.AddWithValue ("@permalink", Permalink.toString page.permalink)
|
||||
cmd.Parameters.AddWithValue ("@publishedOn", page.publishedOn)
|
||||
cmd.Parameters.AddWithValue ("@updatedOn", page.updatedOn)
|
||||
cmd.Parameters.AddWithValue ("@showInPageList", page.showInPageList)
|
||||
cmd.Parameters.AddWithValue ("@template", maybe page.template)
|
||||
cmd.Parameters.AddWithValue ("@text", page.text)
|
||||
] |> ignore
|
||||
|
||||
/// 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 }
|
||||
}
|
||||
|
||||
/// Append revisions and permalinks to a page
|
||||
let appendPageRevisionsAndPermalinks (page : Page) = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.Parameters.AddWithValue ("@pageId", PageId.toString page.id) |> ignore
|
||||
|
||||
cmd.CommandText <- "SELECT permalink FROM page_permalink WHERE page_id = @pageId"
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
let page = { page with priorPermalinks = toList Map.toPermalink rdr }
|
||||
do! rdr.CloseAsync ()
|
||||
|
||||
cmd.CommandText <- "SELECT as_of, revision_text FROM page_revision WHERE page_id = @pageId ORDER BY as_of DESC"
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return { page with revisions = toList Map.toRevision rdr }
|
||||
}
|
||||
|
||||
/// Return a page with no text (or meta items, prior permalinks, or revisions)
|
||||
let pageWithoutTextOrMeta rdr =
|
||||
{ Map.toPage rdr with 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 ()
|
||||
[ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId)
|
||||
cmd.Parameters.Add ("@name", SqliteType.Text)
|
||||
cmd.Parameters.Add ("@value", SqliteType.Text)
|
||||
] |> ignore
|
||||
let runCmd (item : MetaItem) = backgroundTask {
|
||||
cmd.Parameters["@name" ].Value <- item.name
|
||||
cmd.Parameters["@value"].Value <- item.value
|
||||
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 ()
|
||||
[ cmd.Parameters.AddWithValue ("@pageId", PageId.toString pageId)
|
||||
cmd.Parameters.Add ("@link", SqliteType.Text)
|
||||
] |> ignore
|
||||
let runCmd link = backgroundTask {
|
||||
cmd.Parameters["@link"].Value <- Permalink.toString link
|
||||
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
|
||||
}
|
||||
|
||||
// IMPLEMENTATION FUNCTIONS
|
||||
|
||||
/// Add a page
|
||||
let add page = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
// The page itself
|
||||
cmd.CommandText <-
|
||||
"""INSERT INTO page (
|
||||
id, web_log_id, author_id, title, permalink, published_on, updated_on, show_in_page_list,
|
||||
template, page_text
|
||||
) VALUES (
|
||||
@id, @webLogId, @authorId, @title, @permalink, @publishedOn, @updatedOn, @showInPageList,
|
||||
@template, @text
|
||||
)"""
|
||||
addPageParameters cmd page
|
||||
do! write cmd
|
||||
do! updatePageMeta page.id [] page.metadata
|
||||
do! updatePagePermalinks page.id [] page.priorPermalinks
|
||||
do! updatePageRevisions page.id [] page.revisions
|
||||
}
|
||||
|
||||
/// Get all pages for a web log (without text, revisions, prior permalinks, or metadata)
|
||||
let all webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM page WHERE web_log_id = @webLogId ORDER BY LOWER(title)"
|
||||
addWebLogId cmd webLogId
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return toList pageWithoutTextOrMeta rdr
|
||||
}
|
||||
|
||||
/// Count all pages for the given web log
|
||||
let countAll webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT COUNT(id) FROM page WHERE web_log_id = @webLogId"
|
||||
addWebLogId cmd webLogId
|
||||
return! count cmd
|
||||
}
|
||||
|
||||
/// Count all pages shown in the page list for the given web log
|
||||
let countListed webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""SELECT COUNT(id)
|
||||
FROM page
|
||||
WHERE web_log_id = @webLogId
|
||||
AND show_in_page_list = @showInPageList"""
|
||||
addWebLogId cmd webLogId
|
||||
cmd.Parameters.AddWithValue ("@showInPageList", true) |> ignore
|
||||
return! count cmd
|
||||
}
|
||||
|
||||
/// Find a page by its ID (without revisions and prior permalinks)
|
||||
let findById pageId webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM page WHERE id = @id"
|
||||
cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
match Helpers.verifyWebLog<Page> webLogId (fun it -> it.webLogId) Map.toPage rdr with
|
||||
| Some page ->
|
||||
let! page = appendPageMeta page
|
||||
return Some page
|
||||
| None -> return None
|
||||
}
|
||||
|
||||
/// Find a complete page by its ID
|
||||
let findFullById pageId webLogId = backgroundTask {
|
||||
match! findById pageId webLogId with
|
||||
| Some page ->
|
||||
let! page = appendPageRevisionsAndPermalinks page
|
||||
return Some page
|
||||
| None -> return None
|
||||
}
|
||||
|
||||
let delete pageId webLogId = backgroundTask {
|
||||
match! findById pageId webLogId with
|
||||
| Some _ ->
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.Parameters.AddWithValue ("@id", PageId.toString pageId) |> ignore
|
||||
cmd.CommandText <-
|
||||
"""DELETE FROM page_revision WHERE page_id = @id;
|
||||
DELETE FROM page_permalink WHERE page_id = @id;
|
||||
DELETE FROM page_meta WHERE page_id = @id;
|
||||
DELETE FROM page WHERE id = @id"""
|
||||
do! write cmd
|
||||
return true
|
||||
| None -> return false
|
||||
}
|
||||
|
||||
/// Find a page by its permalink for the given web log
|
||||
let findByPermalink permalink webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM page 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! page = appendPageMeta (Map.toPage rdr)
|
||||
return Some page
|
||||
else
|
||||
return None
|
||||
}
|
||||
|
||||
/// Find the current permalink within a set of potential prior permalinks for the given web log
|
||||
let findCurrentPermalink permalinks webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""SELECT p.permalink
|
||||
FROM page p
|
||||
INNER JOIN page_permalink pp ON pp.page_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
|
||||
}
|
||||
|
||||
/// Get all complete pages for the given web log
|
||||
let 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
|
||||
}
|
||||
|
||||
/// Get all listed pages for the given web log (without revisions, prior permalinks, or text)
|
||||
let 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
|
||||
}
|
||||
|
||||
/// Get a page of pages for the given web log (without revisions, prior permalinks, or metadata)
|
||||
let 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 ("@toSkip", (pageNbr - 1) * 25)
|
||||
] |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return toList Map.toPage rdr
|
||||
}
|
||||
|
||||
/// Restore pages from a backup
|
||||
let restore pages = backgroundTask {
|
||||
for page in pages do
|
||||
do! add page
|
||||
}
|
||||
|
||||
/// Update a page
|
||||
let update (page : Page) = backgroundTask {
|
||||
match! 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 ()
|
||||
}
|
||||
|
||||
/// Update a page's prior permalinks
|
||||
let updatePriorPermalinks pageId webLogId permalinks = backgroundTask {
|
||||
match! findFullById pageId webLogId with
|
||||
| Some page ->
|
||||
do! updatePagePermalinks pageId page.priorPermalinks permalinks
|
||||
return true
|
||||
| None -> return false
|
||||
}
|
||||
|
||||
interface IPageData with
|
||||
member _.add page = add page
|
||||
member _.all webLogId = all webLogId
|
||||
member _.countAll webLogId = countAll webLogId
|
||||
member _.countListed webLogId = countListed webLogId
|
||||
member _.delete pageId webLogId = delete pageId webLogId
|
||||
member _.findById pageId webLogId = findById pageId webLogId
|
||||
member _.findByPermalink permalink webLogId = findByPermalink permalink webLogId
|
||||
member _.findCurrentPermalink permalinks webLogId = findCurrentPermalink permalinks webLogId
|
||||
member _.findFullById pageId webLogId = findFullById pageId webLogId
|
||||
member _.findFullByWebLog webLogId = findFullByWebLog webLogId
|
||||
member _.findListed webLogId = findListed webLogId
|
||||
member _.findPageOfPages webLogId pageNbr = findPageOfPages webLogId pageNbr
|
||||
member _.restore pages = restore pages
|
||||
member _.update page = update page
|
||||
member _.updatePriorPermalinks pageId webLogId permalinks = updatePriorPermalinks pageId webLogId permalinks
|
||||
581
src/MyWebLog.Data/SQLite/SQLitePostData.fs
Normal file
581
src/MyWebLog.Data/SQLite/SQLitePostData.fs
Normal file
@@ -0,0 +1,581 @@
|
||||
namespace MyWebLog.Data.SQLite
|
||||
|
||||
open System
|
||||
open System.Threading.Tasks
|
||||
open Microsoft.Data.Sqlite
|
||||
open MyWebLog
|
||||
open MyWebLog.Data
|
||||
|
||||
/// SQLite myWebLog post data implementation
|
||||
type SQLitePostData (conn : SqliteConnection) =
|
||||
|
||||
// SUPPORT FUNCTIONS
|
||||
|
||||
/// 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", maybe post.publishedOn)
|
||||
cmd.Parameters.AddWithValue ("@updatedOn", post.updatedOn)
|
||||
cmd.Parameters.AddWithValue ("@template", maybe post.template)
|
||||
cmd.Parameters.AddWithValue ("@text", post.text)
|
||||
] |> ignore
|
||||
|
||||
/// Add parameters for episode INSERT or UPDATE statements
|
||||
let addEpisodeParameters (cmd : SqliteCommand) (ep : Episode) =
|
||||
[ cmd.Parameters.AddWithValue ("@media", ep.media)
|
||||
cmd.Parameters.AddWithValue ("@length", ep.length)
|
||||
cmd.Parameters.AddWithValue ("@duration", maybe ep.duration)
|
||||
cmd.Parameters.AddWithValue ("@mediaType", maybe ep.mediaType)
|
||||
cmd.Parameters.AddWithValue ("@imageUrl", maybe ep.imageUrl)
|
||||
cmd.Parameters.AddWithValue ("@subtitle", maybe ep.subtitle)
|
||||
cmd.Parameters.AddWithValue ("@explicit", maybe (ep.explicit |> Option.map ExplicitRating.toString))
|
||||
cmd.Parameters.AddWithValue ("@chapterFile", maybe ep.chapterFile)
|
||||
cmd.Parameters.AddWithValue ("@chapterType", maybe ep.chapterType)
|
||||
cmd.Parameters.AddWithValue ("@transcriptUrl", maybe ep.transcriptUrl)
|
||||
cmd.Parameters.AddWithValue ("@transcriptType", maybe ep.transcriptType)
|
||||
cmd.Parameters.AddWithValue ("@transcriptLang", maybe ep.transcriptLang)
|
||||
cmd.Parameters.AddWithValue ("@transcriptCaptions", maybe ep.transcriptCaptions)
|
||||
cmd.Parameters.AddWithValue ("@seasonNumber", maybe ep.seasonNumber)
|
||||
cmd.Parameters.AddWithValue ("@seasonDescription", maybe ep.seasonDescription)
|
||||
cmd.Parameters.AddWithValue ("@episodeNumber", maybe (ep.episodeNumber |> Option.map string))
|
||||
cmd.Parameters.AddWithValue ("@episodeDescription", maybe ep.episodeDescription)
|
||||
] |> ignore
|
||||
|
||||
/// Append category IDs, tags, and meta items to a post
|
||||
let appendPostCategoryTagAndMeta (post : Post) = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.Parameters.AddWithValue ("@id", PostId.toString post.id) |> ignore
|
||||
|
||||
cmd.CommandText <- "SELECT category_id AS id FROM post_category WHERE post_id = @id"
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
let post = { post with categoryIds = toList Map.toCategoryId rdr }
|
||||
do! rdr.CloseAsync ()
|
||||
|
||||
cmd.CommandText <- "SELECT tag FROM post_tag WHERE post_id = @id"
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
let post = { post with tags = toList (Map.getString "tag") rdr }
|
||||
do! rdr.CloseAsync ()
|
||||
|
||||
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.Parameters.AddWithValue ("@postId", PostId.toString post.id) |> ignore
|
||||
|
||||
cmd.CommandText <- "SELECT permalink FROM post_permalink WHERE post_id = @postId"
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
let post = { post with priorPermalinks = toList Map.toPermalink rdr }
|
||||
do! rdr.CloseAsync ()
|
||||
|
||||
cmd.CommandText <- "SELECT as_of, revision_text FROM post_revision WHERE post_id = @postId ORDER BY as_of DESC"
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return { post with revisions = toList Map.toRevision rdr }
|
||||
}
|
||||
|
||||
/// Return a post with no revisions, prior permalinks, or text
|
||||
let postWithoutText rdr =
|
||||
{ Map.toPost rdr 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 ()
|
||||
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
|
||||
cmd.Parameters.Add ("@categoryId", SqliteType.Text)
|
||||
] |> ignore
|
||||
let runCmd catId = backgroundTask {
|
||||
cmd.Parameters["@categoryId"].Value <- CategoryId.toString catId
|
||||
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 : string list) newTags = backgroundTask {
|
||||
let toDelete, toAdd = diffLists oldTags newTags id
|
||||
if List.isEmpty toDelete && List.isEmpty toAdd then
|
||||
return ()
|
||||
else
|
||||
use cmd = conn.CreateCommand ()
|
||||
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
|
||||
cmd.Parameters.Add ("@tag", SqliteType.Text)
|
||||
] |> ignore
|
||||
let runCmd (tag : string) = backgroundTask {
|
||||
cmd.Parameters["@tag"].Value <- tag
|
||||
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 an episode
|
||||
let updatePostEpisode (post : Post) = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT COUNT(post_id) FROM post_episode WHERE post_id = @postId"
|
||||
cmd.Parameters.AddWithValue ("@postId", PostId.toString post.id) |> ignore
|
||||
let! count = count cmd
|
||||
if count = 1 then
|
||||
match post.episode with
|
||||
| Some ep ->
|
||||
cmd.CommandText <-
|
||||
"""UPDATE post_episode
|
||||
SET media = @media,
|
||||
length = @length,
|
||||
duration = @duration,
|
||||
media_type = @mediaType,
|
||||
image_url = @imageUrl,
|
||||
subtitle = @subtitle,
|
||||
explicit = @explicit,
|
||||
chapter_file = @chapterFile,
|
||||
chapter_type = @chapterType,
|
||||
transcript_url = @transcriptUrl,
|
||||
transcript_type = @transcriptType,
|
||||
transcript_lang = @transcriptLang,
|
||||
transcript_captions = @transcriptCaptions,
|
||||
season_number = @seasonNumber,
|
||||
season_description = @seasonDescription,
|
||||
episode_number = @episodeNumber,
|
||||
episode_description = @episodeDescription
|
||||
WHERE post_id = @postId"""
|
||||
addEpisodeParameters cmd ep
|
||||
do! write cmd
|
||||
| None ->
|
||||
cmd.CommandText <- "DELETE FROM post_episode WHERE post_id = @postId"
|
||||
do! write cmd
|
||||
else
|
||||
match post.episode with
|
||||
| Some ep ->
|
||||
cmd.CommandText <-
|
||||
"""INSERT INTO post_episode (
|
||||
post_id, media, length, duration, media_type, image_url, subtitle, explicit,
|
||||
chapter_file, chapter_type, transcript_url, transcript_type, transcript_lang,
|
||||
transcript_captions, season_number, season_description, episode_number, episode_description
|
||||
) VALUES (
|
||||
@postId, @media, @length, @duration, @mediaType, @imageUrl, @subtitle, @explicit,
|
||||
@chapterFile, @chapterType, @transcriptUrl, @transcriptType, @transcriptLang,
|
||||
@transcriptCaptions, @seasonNumber, @seasonDescription, @episodeNumber, @episodeDescription
|
||||
)"""
|
||||
addEpisodeParameters cmd ep
|
||||
do! write cmd
|
||||
| None -> ()
|
||||
}
|
||||
|
||||
/// 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 ()
|
||||
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
|
||||
cmd.Parameters.Add ("@name", SqliteType.Text)
|
||||
cmd.Parameters.Add ("@value", SqliteType.Text)
|
||||
] |> ignore
|
||||
let runCmd (item : MetaItem) = backgroundTask {
|
||||
cmd.Parameters["@name" ].Value <- item.name
|
||||
cmd.Parameters["@value"].Value <- item.value
|
||||
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 ()
|
||||
[ cmd.Parameters.AddWithValue ("@postId", PostId.toString postId)
|
||||
cmd.Parameters.Add ("@link", SqliteType.Text)
|
||||
] |> ignore
|
||||
let runCmd link = backgroundTask {
|
||||
cmd.Parameters["@link"].Value <- Permalink.toString link
|
||||
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 SELECT statement for a post that will include episode data, if it exists
|
||||
let selectPost = "SELECT p.*, e.* FROM post p LEFT JOIN post_episode e ON e.post_id = p.id"
|
||||
|
||||
// IMPLEMENTATION FUNCTIONS
|
||||
|
||||
/// Add a post
|
||||
let add post = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""INSERT INTO post (
|
||||
id, web_log_id, author_id, status, title, permalink, published_on, updated_on,
|
||||
template, post_text
|
||||
) 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! updatePostEpisode post
|
||||
do! updatePostMeta post.id [] post.metadata
|
||||
do! updatePostPermalinks post.id [] post.priorPermalinks
|
||||
do! updatePostRevisions post.id [] post.revisions
|
||||
}
|
||||
|
||||
/// Count posts in a status for the given web log
|
||||
let countByStatus status webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT COUNT(id) FROM post WHERE web_log_id = @webLogId AND status = @status"
|
||||
addWebLogId cmd webLogId
|
||||
cmd.Parameters.AddWithValue ("@status", PostStatus.toString status) |> ignore
|
||||
return! count cmd
|
||||
}
|
||||
|
||||
/// Find a post by its permalink for the given web log (excluding revisions and prior permalinks)
|
||||
let findByPermalink permalink webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- $"{selectPost} WHERE p.web_log_id = @webLogId AND p.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
|
||||
}
|
||||
|
||||
/// Find a complete post by its ID for the given web log
|
||||
let findFullById postId webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- $"{selectPost} WHERE p.id = @id"
|
||||
cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
match Helpers.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
|
||||
}
|
||||
|
||||
/// Delete a post by its ID for the given web log
|
||||
let delete postId webLogId = backgroundTask {
|
||||
match! findFullById postId webLogId with
|
||||
| Some _ ->
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.Parameters.AddWithValue ("@id", PostId.toString postId) |> ignore
|
||||
cmd.CommandText <-
|
||||
"""DELETE FROM post_revision WHERE post_id = @id;
|
||||
DELETE FROM post_permalink WHERE post_id = @id;
|
||||
DELETE FROM post_meta WHERE post_id = @id;
|
||||
DELETE FROM post_episode WHERE post_id = @id;
|
||||
DELETE FROM post_tag WHERE post_id = @id;
|
||||
DELETE FROM post_category WHERE post_id = @id;
|
||||
DELETE FROM post WHERE id = @id"""
|
||||
do! write cmd
|
||||
return true
|
||||
| None -> return false
|
||||
}
|
||||
|
||||
/// Find the current permalink from a list of potential prior permalinks for the given web log
|
||||
let findCurrentPermalink permalinks webLogId = backgroundTask {
|
||||
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
|
||||
}
|
||||
|
||||
/// Get all complete posts for the given web log
|
||||
let findFullByWebLog webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- $"{selectPost} WHERE p.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
|
||||
}
|
||||
|
||||
/// Get a page of categorized posts for the given web log (excludes revisions and prior permalinks)
|
||||
let findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
$"""{selectPost}
|
||||
INNER JOIN post_category pc ON pc.post_id = p.id
|
||||
WHERE p.web_log_id = @webLogId
|
||||
AND p.status = @status
|
||||
AND pc.category_id IN ("""
|
||||
categoryIds
|
||||
|> List.iteri (fun idx catId ->
|
||||
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
|
||||
cmd.CommandText <- $"{cmd.CommandText}@catId{idx}"
|
||||
cmd.Parameters.AddWithValue ($"@catId{idx}", CategoryId.toString catId) |> ignore)
|
||||
cmd.CommandText <-
|
||||
$"""{cmd.CommandText})
|
||||
ORDER BY published_on DESC
|
||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
|
||||
addWebLogId cmd webLogId
|
||||
cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
let! posts =
|
||||
toList Map.toPost rdr
|
||||
|> List.map (fun post -> backgroundTask { return! appendPostCategoryTagAndMeta post })
|
||||
|> Task.WhenAll
|
||||
return List.ofArray posts
|
||||
}
|
||||
|
||||
/// Get a page of posts for the given web log (excludes text, revisions, and prior permalinks)
|
||||
let findPageOfPosts webLogId pageNbr postsPerPage = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
$"""{selectPost}
|
||||
WHERE p.web_log_id = @webLogId
|
||||
ORDER BY p.published_on DESC NULLS FIRST, p.updated_on
|
||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
|
||||
addWebLogId cmd webLogId
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
let! posts =
|
||||
toList postWithoutText rdr
|
||||
|> List.map (fun post -> backgroundTask { return! appendPostCategoryTagAndMeta post })
|
||||
|> Task.WhenAll
|
||||
return List.ofArray posts
|
||||
}
|
||||
|
||||
/// Get a page of published posts for the given web log (excludes revisions and prior permalinks)
|
||||
let findPageOfPublishedPosts webLogId pageNbr postsPerPage = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
$"""{selectPost}
|
||||
WHERE p.web_log_id = @webLogId
|
||||
AND p.status = @status
|
||||
ORDER BY p.published_on DESC
|
||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
|
||||
addWebLogId cmd webLogId
|
||||
cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published) |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
let! posts =
|
||||
toList Map.toPost rdr
|
||||
|> List.map (fun post -> backgroundTask { return! appendPostCategoryTagAndMeta post })
|
||||
|> Task.WhenAll
|
||||
return List.ofArray posts
|
||||
}
|
||||
|
||||
/// Get a page of tagged posts for the given web log (excludes revisions and prior permalinks)
|
||||
let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
$"""{selectPost}
|
||||
INNER JOIN post_tag pt ON pt.post_id = p.id
|
||||
WHERE p.web_log_id = @webLogId
|
||||
AND p.status = @status
|
||||
AND pt.tag = @tag
|
||||
ORDER BY p.published_on DESC
|
||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
|
||||
addWebLogId cmd webLogId
|
||||
[ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published)
|
||||
cmd.Parameters.AddWithValue ("@tag", tag)
|
||||
] |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
let! posts =
|
||||
toList Map.toPost rdr
|
||||
|> List.map (fun post -> backgroundTask { return! appendPostCategoryTagAndMeta post })
|
||||
|> Task.WhenAll
|
||||
return List.ofArray posts
|
||||
}
|
||||
|
||||
/// Find the next newest and oldest post from a publish date for the given web log
|
||||
let findSurroundingPosts webLogId (publishedOn : DateTime) = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
$"""{selectPost}
|
||||
WHERE p.web_log_id = @webLogId
|
||||
AND p.status = @status
|
||||
AND p.published_on < @publishedOn
|
||||
ORDER BY p.published_on DESC
|
||||
LIMIT 1"""
|
||||
addWebLogId cmd webLogId
|
||||
[ cmd.Parameters.AddWithValue ("@status", PostStatus.toString Published)
|
||||
cmd.Parameters.AddWithValue ("@publishedOn", publishedOn)
|
||||
] |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
let! older = backgroundTask {
|
||||
if rdr.Read () then
|
||||
let! post = appendPostCategoryTagAndMeta (postWithoutText rdr)
|
||||
return Some post
|
||||
else
|
||||
return None
|
||||
}
|
||||
do! rdr.CloseAsync ()
|
||||
cmd.CommandText <-
|
||||
$"""{selectPost}
|
||||
WHERE p.web_log_id = @webLogId
|
||||
AND p.status = @status
|
||||
AND p.published_on > @publishedOn
|
||||
ORDER BY p.published_on
|
||||
LIMIT 1"""
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
let! newer = backgroundTask {
|
||||
if rdr.Read () then
|
||||
let! post = appendPostCategoryTagAndMeta (postWithoutText rdr)
|
||||
return Some post
|
||||
else
|
||||
return None
|
||||
}
|
||||
return older, newer
|
||||
}
|
||||
|
||||
/// Restore posts from a backup
|
||||
let restore posts = backgroundTask {
|
||||
for post in posts do
|
||||
do! add post
|
||||
}
|
||||
|
||||
/// Update a post
|
||||
let update (post : Post) = backgroundTask {
|
||||
match! findFullById post.id post.webLogId with
|
||||
| Some oldPost ->
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""UPDATE post
|
||||
SET author_id = @authorId,
|
||||
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! updatePostEpisode post
|
||||
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 ()
|
||||
}
|
||||
|
||||
/// Update prior permalinks for a post
|
||||
let updatePriorPermalinks postId webLogId permalinks = backgroundTask {
|
||||
match! findFullById postId webLogId with
|
||||
| Some post ->
|
||||
do! updatePostPermalinks postId post.priorPermalinks permalinks
|
||||
return true
|
||||
| None -> return false
|
||||
}
|
||||
|
||||
interface IPostData with
|
||||
member _.add post = add post
|
||||
member _.countByStatus status webLogId = countByStatus status webLogId
|
||||
member _.delete postId webLogId = delete postId webLogId
|
||||
member _.findByPermalink permalink webLogId = findByPermalink permalink webLogId
|
||||
member _.findCurrentPermalink permalinks webLogId = findCurrentPermalink permalinks webLogId
|
||||
member _.findFullById postId webLogId = findFullById postId webLogId
|
||||
member _.findFullByWebLog webLogId = findFullByWebLog webLogId
|
||||
member _.findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage =
|
||||
findPageOfCategorizedPosts webLogId categoryIds pageNbr postsPerPage
|
||||
member _.findPageOfPosts webLogId pageNbr postsPerPage = findPageOfPosts webLogId pageNbr postsPerPage
|
||||
member _.findPageOfPublishedPosts webLogId pageNbr postsPerPage =
|
||||
findPageOfPublishedPosts webLogId pageNbr postsPerPage
|
||||
member _.findPageOfTaggedPosts webLogId tag pageNbr postsPerPage =
|
||||
findPageOfTaggedPosts webLogId tag pageNbr postsPerPage
|
||||
member _.findSurroundingPosts webLogId publishedOn = findSurroundingPosts webLogId publishedOn
|
||||
member _.restore posts = restore posts
|
||||
member _.update post = update post
|
||||
member _.updatePriorPermalinks postId webLogId permalinks = updatePriorPermalinks postId webLogId permalinks
|
||||
108
src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs
Normal file
108
src/MyWebLog.Data/SQLite/SQLiteTagMapData.fs
Normal file
@@ -0,0 +1,108 @@
|
||||
namespace MyWebLog.Data.SQLite
|
||||
|
||||
open Microsoft.Data.Sqlite
|
||||
open MyWebLog
|
||||
open MyWebLog.Data
|
||||
|
||||
/// SQLite myWebLog tag mapping data implementation
|
||||
type SQLiteTagMapData (conn : SqliteConnection) =
|
||||
|
||||
/// Find a tag mapping by its ID for the given web log
|
||||
let findById tagMapId webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM tag_map WHERE id = @id"
|
||||
cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMapId) |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return Helpers.verifyWebLog<TagMap> webLogId (fun tm -> tm.webLogId) Map.toTagMap rdr
|
||||
}
|
||||
|
||||
/// Delete a tag mapping for the given web log
|
||||
let delete tagMapId webLogId = backgroundTask {
|
||||
match! findById tagMapId webLogId with
|
||||
| Some _ ->
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "DELETE FROM tag_map WHERE id = @id"
|
||||
cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMapId) |> ignore
|
||||
do! write cmd
|
||||
return true
|
||||
| None -> return false
|
||||
}
|
||||
|
||||
/// Find a tag mapping by its URL value for the given web log
|
||||
let findByUrlValue (urlValue : string) webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM tag_map WHERE web_log_id = @webLogId AND url_value = @urlValue"
|
||||
addWebLogId cmd webLogId
|
||||
cmd.Parameters.AddWithValue ("@urlValue", urlValue) |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return if rdr.Read () then Some (Map.toTagMap rdr) else None
|
||||
}
|
||||
|
||||
/// Get all tag mappings for the given web log
|
||||
let findByWebLog webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM tag_map WHERE web_log_id = @webLogId ORDER BY tag"
|
||||
addWebLogId cmd webLogId
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return toList Map.toTagMap rdr
|
||||
}
|
||||
|
||||
/// Find any tag mappings in a list of tags for the given web log
|
||||
let findMappingForTags (tags : string list) webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""SELECT *
|
||||
FROM tag_map
|
||||
WHERE web_log_id = @webLogId
|
||||
AND tag IN ("""
|
||||
tags
|
||||
|> List.iteri (fun idx tag ->
|
||||
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
|
||||
cmd.CommandText <- $"{cmd.CommandText}@tag{idx}"
|
||||
cmd.Parameters.AddWithValue ($"@tag{idx}", tag) |> ignore)
|
||||
cmd.CommandText <- $"{cmd.CommandText})"
|
||||
addWebLogId cmd webLogId
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return toList Map.toTagMap rdr
|
||||
}
|
||||
|
||||
/// Save a tag mapping
|
||||
let save (tagMap : TagMap) = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
match! findById tagMap.id tagMap.webLogId with
|
||||
| Some _ ->
|
||||
cmd.CommandText <-
|
||||
"""UPDATE tag_map
|
||||
SET tag = @tag,
|
||||
url_value = @urlValue
|
||||
WHERE id = @id
|
||||
AND web_log_id = @webLogId"""
|
||||
| None ->
|
||||
cmd.CommandText <-
|
||||
"""INSERT INTO tag_map (
|
||||
id, web_log_id, tag, url_value
|
||||
) VALUES (
|
||||
@id, @webLogId, @tag, @urlValue
|
||||
)"""
|
||||
addWebLogId cmd tagMap.webLogId
|
||||
[ cmd.Parameters.AddWithValue ("@id", TagMapId.toString tagMap.id)
|
||||
cmd.Parameters.AddWithValue ("@tag", tagMap.tag)
|
||||
cmd.Parameters.AddWithValue ("@urlValue", tagMap.urlValue)
|
||||
] |> ignore
|
||||
do! write cmd
|
||||
}
|
||||
|
||||
/// Restore tag mappings from a backup
|
||||
let restore tagMaps = backgroundTask {
|
||||
for tagMap in tagMaps do
|
||||
do! save tagMap
|
||||
}
|
||||
|
||||
interface ITagMapData with
|
||||
member _.delete tagMapId webLogId = delete tagMapId webLogId
|
||||
member _.findById tagMapId webLogId = findById tagMapId webLogId
|
||||
member _.findByUrlValue urlValue webLogId = findByUrlValue urlValue webLogId
|
||||
member _.findByWebLog webLogId = findByWebLog webLogId
|
||||
member _.findMappingForTags tags webLogId = findMappingForTags tags webLogId
|
||||
member _.save tagMap = save tagMap
|
||||
member this.restore tagMaps = restore tagMaps
|
||||
207
src/MyWebLog.Data/SQLite/SQLiteThemeData.fs
Normal file
207
src/MyWebLog.Data/SQLite/SQLiteThemeData.fs
Normal file
@@ -0,0 +1,207 @@
|
||||
namespace MyWebLog.Data.SQLite
|
||||
|
||||
open System.Threading.Tasks
|
||||
open Microsoft.Data.Sqlite
|
||||
open MyWebLog
|
||||
open MyWebLog.Data
|
||||
|
||||
/// SQLite myWebLog theme data implementation
|
||||
type SQLiteThemeData (conn : SqliteConnection) =
|
||||
|
||||
/// Retrieve all themes (except 'admin'; excludes templates)
|
||||
let all () = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM theme WHERE id <> 'admin' ORDER BY id"
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return toList Map.toTheme rdr
|
||||
}
|
||||
|
||||
/// Find a theme by its ID
|
||||
let findById themeId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM theme WHERE id = @id"
|
||||
cmd.Parameters.AddWithValue ("@id", ThemeId.toString themeId) |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
if rdr.Read () then
|
||||
let theme = Map.toTheme rdr
|
||||
let templateCmd = conn.CreateCommand ()
|
||||
templateCmd.CommandText <- "SELECT * FROM theme_template WHERE theme_id = @id"
|
||||
templateCmd.Parameters.Add cmd.Parameters["@id"] |> ignore
|
||||
use! templateRdr = templateCmd.ExecuteReaderAsync ()
|
||||
return Some { theme with templates = toList Map.toThemeTemplate templateRdr }
|
||||
else
|
||||
return None
|
||||
}
|
||||
|
||||
/// Find a theme by its ID (excludes the text of templates)
|
||||
let findByIdWithoutText themeId = backgroundTask {
|
||||
match! findById themeId with
|
||||
| Some theme ->
|
||||
return Some {
|
||||
theme with templates = theme.templates |> List.map (fun t -> { t with text = "" })
|
||||
}
|
||||
| None -> return None
|
||||
}
|
||||
|
||||
/// Save a theme
|
||||
let save (theme : Theme) = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
let! oldTheme = findById theme.id
|
||||
cmd.CommandText <-
|
||||
match oldTheme with
|
||||
| Some _ -> "UPDATE theme SET name = @name, version = @version WHERE id = @id"
|
||||
| None -> "INSERT INTO theme VALUES (@id, @name, @version)"
|
||||
[ cmd.Parameters.AddWithValue ("@id", ThemeId.toString theme.id)
|
||||
cmd.Parameters.AddWithValue ("@name", theme.name)
|
||||
cmd.Parameters.AddWithValue ("@version", theme.version)
|
||||
] |> ignore
|
||||
do! write cmd
|
||||
|
||||
let toDelete, toAdd =
|
||||
diffLists (oldTheme |> Option.map (fun t -> t.templates) |> Option.defaultValue [])
|
||||
theme.templates (fun t -> t.name)
|
||||
let toUpdate =
|
||||
theme.templates
|
||||
|> List.filter (fun t ->
|
||||
not (toDelete |> List.exists (fun d -> d.name = t.name))
|
||||
&& not (toAdd |> List.exists (fun a -> a.name = t.name)))
|
||||
cmd.CommandText <-
|
||||
"UPDATE theme_template SET template = @template WHERE theme_id = @themeId AND name = @name"
|
||||
cmd.Parameters.Clear ()
|
||||
[ cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString theme.id)
|
||||
cmd.Parameters.Add ("@name", SqliteType.Text)
|
||||
cmd.Parameters.Add ("@template", SqliteType.Text)
|
||||
] |> ignore
|
||||
toUpdate
|
||||
|> List.map (fun template -> backgroundTask {
|
||||
cmd.Parameters["@name" ].Value <- template.name
|
||||
cmd.Parameters["@template"].Value <- template.text
|
||||
do! write cmd
|
||||
})
|
||||
|> Task.WhenAll
|
||||
|> ignore
|
||||
cmd.CommandText <- "INSERT INTO theme_template VALUES (@themeId, @name, @template)"
|
||||
toAdd
|
||||
|> List.map (fun template -> backgroundTask {
|
||||
cmd.Parameters["@name" ].Value <- template.name
|
||||
cmd.Parameters["@template"].Value <- template.text
|
||||
do! write cmd
|
||||
})
|
||||
|> Task.WhenAll
|
||||
|> ignore
|
||||
cmd.CommandText <- "DELETE FROM theme_template WHERE theme_id = @themeId AND name = @name"
|
||||
cmd.Parameters.Remove cmd.Parameters["@template"]
|
||||
toDelete
|
||||
|> List.map (fun template -> backgroundTask {
|
||||
cmd.Parameters["@name"].Value <- template.name
|
||||
do! write cmd
|
||||
})
|
||||
|> Task.WhenAll
|
||||
|> ignore
|
||||
}
|
||||
|
||||
interface IThemeData with
|
||||
member _.all () = all ()
|
||||
member _.findById themeId = findById themeId
|
||||
member _.findByIdWithoutText themeId = findByIdWithoutText themeId
|
||||
member _.save theme = save theme
|
||||
|
||||
|
||||
open System.IO
|
||||
|
||||
/// SQLite myWebLog theme data implementation
|
||||
type SQLiteThemeAssetData (conn : SqliteConnection) =
|
||||
|
||||
/// Get all theme assets (excludes data)
|
||||
let all () = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT theme_id, path, updated_on FROM theme_asset"
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return toList (Map.toThemeAsset false) rdr
|
||||
}
|
||||
|
||||
/// Delete all assets for the given theme
|
||||
let deleteByTheme themeId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "DELETE FROM theme_asset WHERE theme_id = @themeId"
|
||||
cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString themeId) |> ignore
|
||||
do! write cmd
|
||||
}
|
||||
|
||||
/// Find a theme asset by its ID
|
||||
let findById assetId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT *, ROWID FROM theme_asset WHERE theme_id = @themeId AND path = @path"
|
||||
let (ThemeAssetId (ThemeId themeId, path)) = assetId
|
||||
[ cmd.Parameters.AddWithValue ("@themeId", themeId)
|
||||
cmd.Parameters.AddWithValue ("@path", path)
|
||||
] |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return if rdr.Read () then Some (Map.toThemeAsset true rdr) else None
|
||||
}
|
||||
|
||||
/// Get theme assets for the given theme (excludes data)
|
||||
let findByTheme themeId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT theme_id, path, updated_on FROM theme_asset WHERE theme_id = @themeId"
|
||||
cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString themeId) |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return toList (Map.toThemeAsset false) rdr
|
||||
}
|
||||
|
||||
/// Get theme assets for the given theme
|
||||
let findByThemeWithData themeId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT *, ROWID FROM theme_asset WHERE theme_id = @themeId"
|
||||
cmd.Parameters.AddWithValue ("@themeId", ThemeId.toString themeId) |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return toList (Map.toThemeAsset true) rdr
|
||||
}
|
||||
|
||||
/// Save a theme asset
|
||||
let save (asset : ThemeAsset) = backgroundTask {
|
||||
use sideCmd = conn.CreateCommand ()
|
||||
sideCmd.CommandText <-
|
||||
"SELECT COUNT(path) FROM theme_asset WHERE theme_id = @themeId AND path = @path"
|
||||
let (ThemeAssetId (ThemeId themeId, path)) = asset.id
|
||||
[ sideCmd.Parameters.AddWithValue ("@themeId", themeId)
|
||||
sideCmd.Parameters.AddWithValue ("@path", path)
|
||||
] |> ignore
|
||||
let! exists = count sideCmd
|
||||
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
if exists = 1 then
|
||||
"""UPDATE theme_asset
|
||||
SET updated_on = @updatedOn,
|
||||
data = ZEROBLOB(@dataLength)
|
||||
WHERE theme_id = @themeId
|
||||
AND path = @path"""
|
||||
else
|
||||
"""INSERT INTO theme_asset (
|
||||
theme_id, path, updated_on, data
|
||||
) VALUES (
|
||||
@themeId, @path, @updatedOn, ZEROBLOB(@dataLength)
|
||||
)"""
|
||||
[ cmd.Parameters.AddWithValue ("@themeId", themeId)
|
||||
cmd.Parameters.AddWithValue ("@path", path)
|
||||
cmd.Parameters.AddWithValue ("@updatedOn", asset.updatedOn)
|
||||
cmd.Parameters.AddWithValue ("@dataLength", asset.data.Length)
|
||||
] |> ignore
|
||||
do! write cmd
|
||||
|
||||
sideCmd.CommandText <- "SELECT ROWID FROM theme_asset WHERE theme_id = @themeId AND path = @path"
|
||||
let! rowId = sideCmd.ExecuteScalarAsync ()
|
||||
|
||||
use dataStream = new MemoryStream (asset.data)
|
||||
use blobStream = new SqliteBlob (conn, "theme_asset", "data", rowId :?> int64)
|
||||
do! dataStream.CopyToAsync blobStream
|
||||
}
|
||||
|
||||
interface IThemeAssetData with
|
||||
member _.all () = all ()
|
||||
member _.deleteByTheme themeId = deleteByTheme themeId
|
||||
member _.findById assetId = findById assetId
|
||||
member _.findByTheme themeId = findByTheme themeId
|
||||
member _.findByThemeWithData themeId = findByThemeWithData themeId
|
||||
member _.save asset = save asset
|
||||
331
src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs
Normal file
331
src/MyWebLog.Data/SQLite/SQLiteWebLogData.fs
Normal file
@@ -0,0 +1,331 @@
|
||||
namespace MyWebLog.Data.SQLite
|
||||
|
||||
open System.Threading.Tasks
|
||||
open Microsoft.Data.Sqlite
|
||||
open MyWebLog
|
||||
open MyWebLog.Data
|
||||
|
||||
// The web log podcast insert loop is not statically compilable; this is OK
|
||||
#nowarn "3511"
|
||||
|
||||
/// SQLite myWebLog web log data implementation
|
||||
type SQLiteWebLogData (conn : SqliteConnection) =
|
||||
|
||||
// SUPPORT FUNCTIONS
|
||||
|
||||
/// Add parameters for web log INSERT or web log/RSS options UPDATE statements
|
||||
let addWebLogRssParameters (cmd : SqliteCommand) (webLog : WebLog) =
|
||||
[ cmd.Parameters.AddWithValue ("@feedEnabled", webLog.rss.feedEnabled)
|
||||
cmd.Parameters.AddWithValue ("@feedName", webLog.rss.feedName)
|
||||
cmd.Parameters.AddWithValue ("@itemsInFeed", maybe webLog.rss.itemsInFeed)
|
||||
cmd.Parameters.AddWithValue ("@categoryEnabled", webLog.rss.categoryEnabled)
|
||||
cmd.Parameters.AddWithValue ("@tagEnabled", webLog.rss.tagEnabled)
|
||||
cmd.Parameters.AddWithValue ("@copyright", maybe webLog.rss.copyright)
|
||||
] |> ignore
|
||||
|
||||
/// Add parameters for web log INSERT or UPDATE statements
|
||||
let addWebLogParameters (cmd : SqliteCommand) (webLog : WebLog) =
|
||||
[ cmd.Parameters.AddWithValue ("@id", WebLogId.toString webLog.id)
|
||||
cmd.Parameters.AddWithValue ("@name", webLog.name)
|
||||
cmd.Parameters.AddWithValue ("@subtitle", maybe webLog.subtitle)
|
||||
cmd.Parameters.AddWithValue ("@defaultPage", webLog.defaultPage)
|
||||
cmd.Parameters.AddWithValue ("@postsPerPage", webLog.postsPerPage)
|
||||
cmd.Parameters.AddWithValue ("@themeId", webLog.themePath)
|
||||
cmd.Parameters.AddWithValue ("@urlBase", webLog.urlBase)
|
||||
cmd.Parameters.AddWithValue ("@timeZone", webLog.timeZone)
|
||||
cmd.Parameters.AddWithValue ("@autoHtmx", webLog.autoHtmx)
|
||||
] |> ignore
|
||||
addWebLogRssParameters cmd webLog
|
||||
|
||||
/// Add parameters for custom feed INSERT or UPDATE statements
|
||||
let addCustomFeedParameters (cmd : SqliteCommand) webLogId (feed : CustomFeed) =
|
||||
[ cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString feed.id)
|
||||
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString webLogId)
|
||||
cmd.Parameters.AddWithValue ("@source", CustomFeedSource.toString feed.source)
|
||||
cmd.Parameters.AddWithValue ("@path", Permalink.toString feed.path)
|
||||
] |> ignore
|
||||
|
||||
/// Add parameters for podcast INSERT or UPDATE statements
|
||||
let addPodcastParameters (cmd : SqliteCommand) feedId (podcast : PodcastOptions) =
|
||||
[ cmd.Parameters.AddWithValue ("@feedId", CustomFeedId.toString feedId)
|
||||
cmd.Parameters.AddWithValue ("@title", podcast.title)
|
||||
cmd.Parameters.AddWithValue ("@subtitle", maybe podcast.subtitle)
|
||||
cmd.Parameters.AddWithValue ("@itemsInFeed", podcast.itemsInFeed)
|
||||
cmd.Parameters.AddWithValue ("@summary", podcast.summary)
|
||||
cmd.Parameters.AddWithValue ("@displayedAuthor", podcast.displayedAuthor)
|
||||
cmd.Parameters.AddWithValue ("@email", podcast.email)
|
||||
cmd.Parameters.AddWithValue ("@imageUrl", Permalink.toString podcast.imageUrl)
|
||||
cmd.Parameters.AddWithValue ("@iTunesCategory", podcast.iTunesCategory)
|
||||
cmd.Parameters.AddWithValue ("@iTunesSubcategory", maybe podcast.iTunesSubcategory)
|
||||
cmd.Parameters.AddWithValue ("@explicit", ExplicitRating.toString podcast.explicit)
|
||||
cmd.Parameters.AddWithValue ("@defaultMediaType", maybe podcast.defaultMediaType)
|
||||
cmd.Parameters.AddWithValue ("@mediaBaseUrl", maybe podcast.mediaBaseUrl)
|
||||
cmd.Parameters.AddWithValue ("@guid", maybe podcast.guid)
|
||||
cmd.Parameters.AddWithValue ("@fundingUrl", maybe podcast.fundingUrl)
|
||||
cmd.Parameters.AddWithValue ("@fundingText", maybe podcast.fundingText)
|
||||
cmd.Parameters.AddWithValue ("@medium", maybe (podcast.medium |> Option.map PodcastMedium.toString))
|
||||
] |> ignore
|
||||
|
||||
/// Get the current custom feeds for a web log
|
||||
let getCustomFeeds (webLog : WebLog) = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""SELECT f.*, p.*
|
||||
FROM web_log_feed f
|
||||
LEFT JOIN web_log_feed_podcast p ON p.feed_id = f.id
|
||||
WHERE f.web_log_id = @webLogId"""
|
||||
addWebLogId cmd webLog.id
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return toList Map.toCustomFeed rdr
|
||||
}
|
||||
|
||||
/// Append custom feeds to a web log
|
||||
let appendCustomFeeds (webLog : WebLog) = backgroundTask {
|
||||
let! feeds = getCustomFeeds webLog
|
||||
return { webLog with rss = { webLog.rss with customFeeds = feeds } }
|
||||
}
|
||||
|
||||
/// Add a podcast to a custom feed
|
||||
let addPodcast feedId (podcast : PodcastOptions) = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""INSERT INTO web_log_feed_podcast (
|
||||
feed_id, title, subtitle, items_in_feed, summary, displayed_author, email,
|
||||
image_url, itunes_category, itunes_subcategory, explicit, default_media_type,
|
||||
media_base_url, guid, funding_url, funding_text, medium
|
||||
) VALUES (
|
||||
@feedId, @title, @subtitle, @itemsInFeed, @summary, @displayedAuthor, @email,
|
||||
@imageUrl, @iTunesCategory, @iTunesSubcategory, @explicit, @defaultMediaType,
|
||||
@mediaBaseUrl, @guid, @fundingUrl, @fundingText, @medium
|
||||
)"""
|
||||
addPodcastParameters cmd feedId podcast
|
||||
do! write cmd
|
||||
}
|
||||
|
||||
/// Update the custom feeds for a web log
|
||||
let updateCustomFeeds (webLog : WebLog) = backgroundTask {
|
||||
let! feeds = getCustomFeeds webLog
|
||||
let toDelete, toAdd = diffLists feeds webLog.rss.customFeeds (fun it -> $"{CustomFeedId.toString it.id}")
|
||||
let toId (feed : CustomFeed) = feed.id
|
||||
let toUpdate =
|
||||
webLog.rss.customFeeds
|
||||
|> List.filter (fun f ->
|
||||
not (toDelete |> List.map toId |> List.append (toAdd |> List.map toId) |> List.contains f.id))
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.Parameters.Add ("@id", SqliteType.Text) |> ignore
|
||||
toDelete
|
||||
|> List.map (fun it -> backgroundTask {
|
||||
cmd.CommandText <-
|
||||
"""DELETE FROM web_log_feed_podcast WHERE feed_id = @id;
|
||||
DELETE FROM web_log_feed WHERE id = @id"""
|
||||
cmd.Parameters["@id"].Value <- CustomFeedId.toString it.id
|
||||
do! write cmd
|
||||
})
|
||||
|> Task.WhenAll
|
||||
|> ignore
|
||||
cmd.Parameters.Clear ()
|
||||
toAdd
|
||||
|> List.map (fun it -> backgroundTask {
|
||||
cmd.CommandText <-
|
||||
"""INSERT INTO web_log_feed (
|
||||
id, web_log_id, source, path
|
||||
) VALUES (
|
||||
@id, @webLogId, @source, @path
|
||||
)"""
|
||||
cmd.Parameters.Clear ()
|
||||
addCustomFeedParameters cmd webLog.id it
|
||||
do! write cmd
|
||||
match it.podcast with
|
||||
| Some podcast -> do! addPodcast it.id podcast
|
||||
| None -> ()
|
||||
})
|
||||
|> Task.WhenAll
|
||||
|> ignore
|
||||
toUpdate
|
||||
|> List.map (fun it -> backgroundTask {
|
||||
cmd.CommandText <-
|
||||
"""UPDATE web_log_feed
|
||||
SET source = @source,
|
||||
path = @path
|
||||
WHERE id = @id
|
||||
AND web_log_id = @webLogId"""
|
||||
cmd.Parameters.Clear ()
|
||||
addCustomFeedParameters cmd webLog.id it
|
||||
do! write cmd
|
||||
let hadPodcast = Option.isSome (feeds |> List.find (fun f -> f.id = it.id)).podcast
|
||||
match it.podcast with
|
||||
| Some podcast ->
|
||||
if hadPodcast then
|
||||
cmd.CommandText <-
|
||||
"""UPDATE web_log_feed_podcast
|
||||
SET title = @title,
|
||||
subtitle = @subtitle,
|
||||
items_in_feed = @itemsInFeed,
|
||||
summary = @summary,
|
||||
displayed_author = @displayedAuthor,
|
||||
email = @email,
|
||||
image_url = @imageUrl,
|
||||
itunes_category = @iTunesCategory,
|
||||
itunes_subcategory = @iTunesSubcategory,
|
||||
explicit = @explicit,
|
||||
default_media_type = @defaultMediaType,
|
||||
media_base_url = @mediaBaseUrl,
|
||||
guid = @guid,
|
||||
funding_url = @fundingUrl,
|
||||
funding_text = @fundingText,
|
||||
medium = @medium
|
||||
WHERE feed_id = @feedId"""
|
||||
cmd.Parameters.Clear ()
|
||||
addPodcastParameters cmd it.id podcast
|
||||
do! write cmd
|
||||
else
|
||||
do! addPodcast it.id podcast
|
||||
| None ->
|
||||
if hadPodcast then
|
||||
cmd.CommandText <- "DELETE FROM web_log_feed_podcast WHERE feed_id = @id"
|
||||
cmd.Parameters.Clear ()
|
||||
cmd.Parameters.AddWithValue ("@id", CustomFeedId.toString it.id) |> ignore
|
||||
do! write cmd
|
||||
else
|
||||
()
|
||||
})
|
||||
|> Task.WhenAll
|
||||
|> ignore
|
||||
}
|
||||
|
||||
// IMPLEMENTATION FUNCTIONS
|
||||
|
||||
/// Add a web log
|
||||
let add webLog = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""INSERT INTO web_log (
|
||||
id, name, subtitle, default_page, posts_per_page, theme_id, url_base, time_zone,
|
||||
auto_htmx, feed_enabled, feed_name, items_in_feed, category_enabled, tag_enabled,
|
||||
copyright
|
||||
) VALUES (
|
||||
@id, @name, @subtitle, @defaultPage, @postsPerPage, @themeId, @urlBase, @timeZone,
|
||||
@autoHtmx, @feedEnabled, @feedName, @itemsInFeed, @categoryEnabled, @tagEnabled,
|
||||
@copyright
|
||||
)"""
|
||||
addWebLogParameters cmd webLog
|
||||
do! write cmd
|
||||
do! updateCustomFeeds webLog
|
||||
}
|
||||
|
||||
/// Retrieve all web logs
|
||||
let all () = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM web_log"
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
let! webLogs =
|
||||
toList Map.toWebLog rdr
|
||||
|> List.map (fun webLog -> backgroundTask { return! appendCustomFeeds webLog })
|
||||
|> Task.WhenAll
|
||||
return List.ofArray webLogs
|
||||
}
|
||||
|
||||
/// Delete a web log by its ID
|
||||
let delete webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
addWebLogId cmd webLogId
|
||||
let subQuery table = $"(SELECT id FROM {table} WHERE web_log_id = @webLogId)"
|
||||
let postSubQuery = subQuery "post"
|
||||
let pageSubQuery = subQuery "page"
|
||||
cmd.CommandText <-
|
||||
$"""DELETE FROM post_comment WHERE post_id IN {postSubQuery};
|
||||
DELETE FROM post_revision WHERE post_id IN {postSubQuery};
|
||||
DELETE FROM post_permalink WHERE post_id IN {postSubQuery};
|
||||
DELETE FROM post_episode WHERE post_id IN {postSubQuery};
|
||||
DELETE FROM post_tag WHERE post_id IN {postSubQuery};
|
||||
DELETE FROM post_category WHERE post_id IN {postSubQuery};
|
||||
DELETE FROM post_meta WHERE post_id IN {postSubQuery};
|
||||
DELETE FROM post WHERE web_log_id = @webLogId;
|
||||
DELETE FROM page_revision WHERE page_id IN {pageSubQuery};
|
||||
DELETE FROM page_permalink WHERE page_id IN {pageSubQuery};
|
||||
DELETE FROM page_meta WHERE page_id IN {pageSubQuery};
|
||||
DELETE FROM page WHERE web_log_id = @webLogId;
|
||||
DELETE FROM category WHERE web_log_id = @webLogId;
|
||||
DELETE FROM tag_map WHERE web_log_id = @webLogId;
|
||||
DELETE FROM web_log_user WHERE web_log_id = @webLogId;
|
||||
DELETE FROM web_log_feed_podcast WHERE feed_id IN {subQuery "web_log_feed"};
|
||||
DELETE FROM web_log_feed WHERE web_log_id = @webLogId;
|
||||
DELETE FROM web_log WHERE id = @webLogId"""
|
||||
do! write cmd
|
||||
}
|
||||
|
||||
/// Find a web log by its host (URL base)
|
||||
let findByHost (url : string) = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM web_log WHERE url_base = @urlBase"
|
||||
cmd.Parameters.AddWithValue ("@urlBase", url) |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
if rdr.Read () then
|
||||
let! webLog = appendCustomFeeds (Map.toWebLog rdr)
|
||||
return Some webLog
|
||||
else
|
||||
return None
|
||||
}
|
||||
|
||||
/// Find a web log by its ID
|
||||
let findById webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM web_log WHERE id = @webLogId"
|
||||
addWebLogId cmd webLogId
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
if rdr.Read () then
|
||||
let! webLog = appendCustomFeeds (Map.toWebLog rdr)
|
||||
return Some webLog
|
||||
else
|
||||
return None
|
||||
}
|
||||
|
||||
/// Update settings for a web log
|
||||
let updateSettings webLog = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""UPDATE web_log
|
||||
SET name = @name,
|
||||
subtitle = @subtitle,
|
||||
default_page = @defaultPage,
|
||||
posts_per_page = @postsPerPage,
|
||||
theme_id = @themeId,
|
||||
url_base = @urlBase,
|
||||
time_zone = @timeZone,
|
||||
auto_htmx = @autoHtmx,
|
||||
feed_enabled = @feedEnabled,
|
||||
feed_name = @feedName,
|
||||
items_in_feed = @itemsInFeed,
|
||||
category_enabled = @categoryEnabled,
|
||||
tag_enabled = @tagEnabled,
|
||||
copyright = @copyright
|
||||
WHERE id = @id"""
|
||||
addWebLogParameters cmd webLog
|
||||
do! write cmd
|
||||
}
|
||||
|
||||
/// Update RSS options for a web log
|
||||
let updateRssOptions webLog = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""UPDATE web_log
|
||||
SET feed_enabled = @feedEnabled,
|
||||
feed_name = @feedName,
|
||||
items_in_feed = @itemsInFeed,
|
||||
category_enabled = @categoryEnabled,
|
||||
tag_enabled = @tagEnabled,
|
||||
copyright = @copyright
|
||||
WHERE id = @id"""
|
||||
addWebLogRssParameters cmd webLog
|
||||
do! write cmd
|
||||
do! updateCustomFeeds webLog
|
||||
}
|
||||
|
||||
interface IWebLogData with
|
||||
member _.add webLog = add webLog
|
||||
member _.all () = all ()
|
||||
member _.delete webLogId = delete webLogId
|
||||
member _.findByHost url = findByHost url
|
||||
member _.findById webLogId = findById webLogId
|
||||
member _.updateSettings webLog = updateSettings webLog
|
||||
member _.updateRssOptions webLog = updateRssOptions webLog
|
||||
121
src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs
Normal file
121
src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs
Normal file
@@ -0,0 +1,121 @@
|
||||
namespace MyWebLog.Data.SQLite
|
||||
|
||||
open Microsoft.Data.Sqlite
|
||||
open MyWebLog
|
||||
open MyWebLog.Data
|
||||
|
||||
/// SQLite myWebLog user data implementation
|
||||
type SQLiteWebLogUserData (conn : SqliteConnection) =
|
||||
|
||||
// SUPPORT FUNCTIONS
|
||||
|
||||
/// Add parameters for web log user INSERT or UPDATE statements
|
||||
let addWebLogUserParameters (cmd : SqliteCommand) (user : WebLogUser) =
|
||||
[ cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString user.id)
|
||||
cmd.Parameters.AddWithValue ("@webLogId", WebLogId.toString user.webLogId)
|
||||
cmd.Parameters.AddWithValue ("@userName", user.userName)
|
||||
cmd.Parameters.AddWithValue ("@firstName", user.firstName)
|
||||
cmd.Parameters.AddWithValue ("@lastName", user.lastName)
|
||||
cmd.Parameters.AddWithValue ("@preferredName", user.preferredName)
|
||||
cmd.Parameters.AddWithValue ("@passwordHash", user.passwordHash)
|
||||
cmd.Parameters.AddWithValue ("@salt", user.salt)
|
||||
cmd.Parameters.AddWithValue ("@url", maybe user.url)
|
||||
cmd.Parameters.AddWithValue ("@authorizationLevel", AuthorizationLevel.toString user.authorizationLevel)
|
||||
] |> ignore
|
||||
|
||||
// IMPLEMENTATION FUNCTIONS
|
||||
|
||||
/// Add a user
|
||||
let add user = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""INSERT INTO web_log_user (
|
||||
id, web_log_id, user_name, first_name, last_name, preferred_name, password_hash, salt,
|
||||
url, authorization_level
|
||||
) VALUES (
|
||||
@id, @webLogId, @userName, @firstName, @lastName, @preferredName, @passwordHash, @salt,
|
||||
@url, @authorizationLevel
|
||||
)"""
|
||||
addWebLogUserParameters cmd user
|
||||
do! write cmd
|
||||
}
|
||||
|
||||
/// Find a user by their e-mail address for the given web log
|
||||
let findByEmail (email : string) webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND user_name = @userName"
|
||||
addWebLogId cmd webLogId
|
||||
cmd.Parameters.AddWithValue ("@userName", email) |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return if rdr.Read () then Some (Map.toWebLogUser rdr) else None
|
||||
}
|
||||
|
||||
/// Find a user by their ID for the given web log
|
||||
let findById userId webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM web_log_user WHERE id = @id"
|
||||
cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId) |> ignore
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return Helpers.verifyWebLog<WebLogUser> webLogId (fun u -> u.webLogId) Map.toWebLogUser rdr
|
||||
}
|
||||
|
||||
/// Get all users for the given web log
|
||||
let findByWebLog webLogId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId"
|
||||
addWebLogId cmd webLogId
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return toList Map.toWebLogUser rdr
|
||||
}
|
||||
|
||||
/// Find the names of users by their IDs for the given web log
|
||||
let findNames webLogId userIds = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND id IN ("
|
||||
userIds
|
||||
|> List.iteri (fun idx userId ->
|
||||
if idx > 0 then cmd.CommandText <- $"{cmd.CommandText}, "
|
||||
cmd.CommandText <- $"{cmd.CommandText}@id{idx}"
|
||||
cmd.Parameters.AddWithValue ($"@id{idx}", WebLogUserId.toString userId) |> ignore)
|
||||
cmd.CommandText <- $"{cmd.CommandText})"
|
||||
addWebLogId cmd webLogId
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
return
|
||||
toList Map.toWebLogUser rdr
|
||||
|> List.map (fun u -> { name = WebLogUserId.toString u.id; value = WebLogUser.displayName u })
|
||||
}
|
||||
|
||||
/// Restore users from a backup
|
||||
let restore users = backgroundTask {
|
||||
for user in users do
|
||||
do! add user
|
||||
}
|
||||
|
||||
/// Update a user
|
||||
let update user = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"""UPDATE web_log_user
|
||||
SET user_name = @userName,
|
||||
first_name = @firstName,
|
||||
last_name = @lastName,
|
||||
preferred_name = @preferredName,
|
||||
password_hash = @passwordHash,
|
||||
salt = @salt,
|
||||
url = @url,
|
||||
authorization_level = @authorizationLevel
|
||||
WHERE id = @id
|
||||
AND web_log_id = @webLogId"""
|
||||
addWebLogUserParameters cmd user
|
||||
do! write cmd
|
||||
}
|
||||
|
||||
interface IWebLogUserData with
|
||||
member _.add user = add user
|
||||
member _.findByEmail email webLogId = findByEmail email webLogId
|
||||
member _.findById userId webLogId = findById userId webLogId
|
||||
member _.findByWebLog webLogId = findByWebLog webLogId
|
||||
member _.findNames webLogId userIds = findNames webLogId userIds
|
||||
member this.restore users = restore users
|
||||
member _.update user = update user
|
||||
File diff suppressed because it is too large
Load Diff
@@ -190,6 +190,9 @@ type Post =
|
||||
/// The tags for the post
|
||||
tags : string list
|
||||
|
||||
/// Podcast episode information for this post
|
||||
episode : Episode option
|
||||
|
||||
/// Metadata for the post
|
||||
metadata : MetaItem list
|
||||
|
||||
@@ -217,6 +220,7 @@ module Post =
|
||||
template = None
|
||||
categoryIds = []
|
||||
tags = []
|
||||
episode = None
|
||||
metadata = []
|
||||
priorPermalinks = []
|
||||
revisions = []
|
||||
|
||||
@@ -68,6 +68,109 @@ module CommentStatus =
|
||||
| it -> invalidOp $"{it} is not a valid post status"
|
||||
|
||||
|
||||
/// Valid values for the iTunes explicit rating
|
||||
type ExplicitRating =
|
||||
| Yes
|
||||
| No
|
||||
| Clean
|
||||
|
||||
/// Functions to support iTunes explicit ratings
|
||||
module ExplicitRating =
|
||||
/// Convert an explicit rating to a string
|
||||
let toString : ExplicitRating -> string =
|
||||
function
|
||||
| Yes -> "yes"
|
||||
| No -> "no"
|
||||
| Clean -> "clean"
|
||||
|
||||
/// Parse a string into an explicit rating
|
||||
let parse : string -> ExplicitRating =
|
||||
function
|
||||
| "yes" -> Yes
|
||||
| "no" -> No
|
||||
| "clean" -> Clean
|
||||
| x -> raise (invalidArg "rating" $"{x} is not a valid explicit rating")
|
||||
|
||||
|
||||
/// A podcast episode
|
||||
type Episode =
|
||||
{ /// The URL to the media file for the episode (may be permalink)
|
||||
media : string
|
||||
|
||||
/// The length of the media file, in bytes
|
||||
length : int64
|
||||
|
||||
/// The duration of the episode
|
||||
duration : TimeSpan option
|
||||
|
||||
/// The media type of the file (overrides podcast default if present)
|
||||
mediaType : string option
|
||||
|
||||
/// The URL to the image file for this episode (overrides podcast image if present, may be permalink)
|
||||
imageUrl : string option
|
||||
|
||||
/// A subtitle for this episode
|
||||
subtitle : string option
|
||||
|
||||
/// This episode's explicit rating (overrides podcast rating if present)
|
||||
explicit : ExplicitRating option
|
||||
|
||||
/// A link to a chapter file
|
||||
chapterFile : string option
|
||||
|
||||
/// The MIME type for the chapter file
|
||||
chapterType : string option
|
||||
|
||||
/// The URL for the transcript of the episode (may be permalink)
|
||||
transcriptUrl : string option
|
||||
|
||||
/// The MIME type of the transcript
|
||||
transcriptType : string option
|
||||
|
||||
/// The language in which the transcript is written
|
||||
transcriptLang : string option
|
||||
|
||||
/// If true, the transcript will be declared (in the feed) to be a captions file
|
||||
transcriptCaptions : bool option
|
||||
|
||||
/// The season number (for serialized podcasts)
|
||||
seasonNumber : int option
|
||||
|
||||
/// A description of the season
|
||||
seasonDescription : string option
|
||||
|
||||
/// The episode number
|
||||
episodeNumber : double option
|
||||
|
||||
/// A description of the episode
|
||||
episodeDescription : string option
|
||||
}
|
||||
|
||||
/// Functions to support episodes
|
||||
module Episode =
|
||||
|
||||
/// An empty episode
|
||||
let empty = {
|
||||
media = ""
|
||||
length = 0L
|
||||
duration = None
|
||||
mediaType = None
|
||||
imageUrl = None
|
||||
subtitle = None
|
||||
explicit = None
|
||||
chapterFile = None
|
||||
chapterType = None
|
||||
transcriptUrl = None
|
||||
transcriptType = None
|
||||
transcriptLang = None
|
||||
transcriptCaptions = None
|
||||
seasonNumber = None
|
||||
seasonDescription = None
|
||||
episodeNumber = None
|
||||
episodeDescription = None
|
||||
}
|
||||
|
||||
|
||||
open Markdig
|
||||
open Markdown.ColorCode
|
||||
|
||||
@@ -171,6 +274,43 @@ module PageId =
|
||||
let create () = PageId (newId ())
|
||||
|
||||
|
||||
/// PodcastIndex.org podcast:medium allowed values
|
||||
type PodcastMedium =
|
||||
| Podcast
|
||||
| Music
|
||||
| Video
|
||||
| Film
|
||||
| Audiobook
|
||||
| Newsletter
|
||||
| Blog
|
||||
|
||||
/// Functions to support podcast medium
|
||||
module PodcastMedium =
|
||||
|
||||
/// Convert a podcast medium to a string
|
||||
let toString =
|
||||
function
|
||||
| Podcast -> "podcast"
|
||||
| Music -> "music"
|
||||
| Video -> "video"
|
||||
| Film -> "film"
|
||||
| Audiobook -> "audiobook"
|
||||
| Newsletter -> "newsletter"
|
||||
| Blog -> "blog"
|
||||
|
||||
/// Parse a string into a podcast medium
|
||||
let parse value =
|
||||
match value with
|
||||
| "podcast" -> Podcast
|
||||
| "music" -> Music
|
||||
| "video" -> Video
|
||||
| "film" -> Film
|
||||
| "audiobook" -> Audiobook
|
||||
| "newsletter" -> Newsletter
|
||||
| "blog" -> Blog
|
||||
| it -> invalidOp $"{it} is not a valid podcast medium"
|
||||
|
||||
|
||||
/// Statuses for posts
|
||||
type PostStatus =
|
||||
/// The post should not be publicly available
|
||||
@@ -248,30 +388,6 @@ module CustomFeedSource =
|
||||
| source -> invalidArg "feedSource" $"{source} is not a valid feed source"
|
||||
|
||||
|
||||
/// Valid values for the iTunes explicit rating
|
||||
type ExplicitRating =
|
||||
| Yes
|
||||
| No
|
||||
| Clean
|
||||
|
||||
/// Functions to support iTunes explicit ratings
|
||||
module ExplicitRating =
|
||||
/// Convert an explicit rating to a string
|
||||
let toString : ExplicitRating -> string =
|
||||
function
|
||||
| Yes -> "yes"
|
||||
| No -> "no"
|
||||
| Clean -> "clean"
|
||||
|
||||
/// Parse a string into an explicit rating
|
||||
let parse : string -> ExplicitRating =
|
||||
function
|
||||
| "yes" -> Yes
|
||||
| "no" -> No
|
||||
| "clean" -> Clean
|
||||
| x -> raise (invalidArg "rating" $"{x} is not a valid explicit rating")
|
||||
|
||||
|
||||
/// Options for a feed that describes a podcast
|
||||
type PodcastOptions =
|
||||
{ /// The title of the podcast
|
||||
@@ -309,6 +425,18 @@ type PodcastOptions =
|
||||
|
||||
/// The base URL for relative URL media files for this podcast (optional; defaults to web log base)
|
||||
mediaBaseUrl : string option
|
||||
|
||||
/// A GUID for this podcast
|
||||
guid : Guid option
|
||||
|
||||
/// A URL at which information on supporting the podcast may be found (supports permalinks)
|
||||
fundingUrl : string option
|
||||
|
||||
/// The text to be displayed in the funding item within the feed
|
||||
fundingText : string option
|
||||
|
||||
/// The medium (what the podcast IS, not what it is ABOUT)
|
||||
medium : PodcastMedium option
|
||||
}
|
||||
|
||||
|
||||
|
||||
@@ -9,7 +9,7 @@ module private Helpers =
|
||||
|
||||
/// Create a string option if a string is blank
|
||||
let noneIfBlank (it : string) =
|
||||
match it.Trim () with "" -> None | trimmed -> Some trimmed
|
||||
match (defaultArg (Option.ofObj it) "").Trim () with "" -> None | trimmed -> Some trimmed
|
||||
|
||||
|
||||
/// Details about a category, used to display category lists
|
||||
@@ -300,6 +300,11 @@ type EditCustomFeedModel =
|
||||
explicit = ExplicitRating.parse this.explicit
|
||||
defaultMediaType = noneIfBlank this.defaultMediaType
|
||||
mediaBaseUrl = noneIfBlank this.mediaBaseUrl
|
||||
// TODO: implement UI to update these
|
||||
guid = None
|
||||
fundingUrl = None
|
||||
fundingText = None
|
||||
medium = None
|
||||
}
|
||||
else
|
||||
None
|
||||
@@ -402,7 +407,62 @@ type EditPostModel =
|
||||
|
||||
/// Whether all revisions should be purged and the override date set as the updated date as well
|
||||
setUpdated : bool
|
||||
|
||||
/// Whether this post has a podcast episode
|
||||
isEpisode : bool
|
||||
|
||||
/// The URL for the media for this episode (may be permalink)
|
||||
media : string
|
||||
|
||||
/// The size (in bytes) of the media for this episode
|
||||
length : int64
|
||||
|
||||
/// The duration of the media for this episode
|
||||
duration : string
|
||||
|
||||
/// The media type (optional, defaults to podcast-defined media type)
|
||||
mediaType : string
|
||||
|
||||
/// The URL for the image for this episode (may be permalink; optional, defaults to podcast image)
|
||||
imageUrl : string
|
||||
|
||||
/// A subtitle for the episode (optional)
|
||||
subtitle : string
|
||||
|
||||
/// The explicit rating for this episode (optional, defaults to podcast setting)
|
||||
explicit : string
|
||||
|
||||
/// The URL for the chapter file for the episode (may be permalink; optional)
|
||||
chapterFile : string
|
||||
|
||||
/// The type of the chapter file (optional; defaults to application/json+chapters if chapterFile is provided)
|
||||
chapterType : string
|
||||
|
||||
/// The URL for the transcript (may be permalink; optional)
|
||||
transcriptUrl : string
|
||||
|
||||
/// The MIME type for the transcript (optional, recommended if transcriptUrl is provided)
|
||||
transcriptType : string
|
||||
|
||||
/// The language of the transcript (optional)
|
||||
transcriptLang : string
|
||||
|
||||
/// Whether the provided transcript should be presented as captions
|
||||
transcriptCaptions : bool
|
||||
|
||||
/// The season number (optional)
|
||||
seasonNumber : int
|
||||
|
||||
/// A description of this season (optional, ignored if season number is not provided)
|
||||
seasonDescription : string
|
||||
|
||||
/// The episode number (decimal; optional)
|
||||
episodeNumber : string
|
||||
|
||||
/// A description of this episode (optional, ignored if episode number is not provided)
|
||||
episodeDescription : string
|
||||
}
|
||||
|
||||
/// Create an edit model from an existing past
|
||||
static member fromPost webLog (post : Post) =
|
||||
let latest =
|
||||
@@ -410,21 +470,93 @@ type EditPostModel =
|
||||
| Some rev -> rev
|
||||
| None -> Revision.empty
|
||||
let post = if post.metadata |> List.isEmpty then { post with metadata = [ MetaItem.empty ] } else post
|
||||
{ postId = PostId.toString post.id
|
||||
title = post.title
|
||||
permalink = Permalink.toString post.permalink
|
||||
source = MarkupText.sourceType latest.text
|
||||
text = MarkupText.text latest.text
|
||||
tags = String.Join (", ", post.tags)
|
||||
template = defaultArg post.template ""
|
||||
categoryIds = post.categoryIds |> List.map CategoryId.toString |> Array.ofList
|
||||
status = PostStatus.toString post.status
|
||||
doPublish = false
|
||||
metaNames = post.metadata |> List.map (fun m -> m.name) |> Array.ofList
|
||||
metaValues = post.metadata |> List.map (fun m -> m.value) |> Array.ofList
|
||||
setPublished = false
|
||||
pubOverride = post.publishedOn |> Option.map (WebLog.localTime webLog) |> Option.toNullable
|
||||
setUpdated = false
|
||||
let episode = defaultArg post.episode Episode.empty
|
||||
{ postId = PostId.toString post.id
|
||||
title = post.title
|
||||
permalink = Permalink.toString post.permalink
|
||||
source = MarkupText.sourceType latest.text
|
||||
text = MarkupText.text latest.text
|
||||
tags = String.Join (", ", post.tags)
|
||||
template = defaultArg post.template ""
|
||||
categoryIds = post.categoryIds |> List.map CategoryId.toString |> Array.ofList
|
||||
status = PostStatus.toString post.status
|
||||
doPublish = false
|
||||
metaNames = post.metadata |> List.map (fun m -> m.name) |> Array.ofList
|
||||
metaValues = post.metadata |> List.map (fun m -> m.value) |> Array.ofList
|
||||
setPublished = false
|
||||
pubOverride = post.publishedOn |> Option.map (WebLog.localTime webLog) |> Option.toNullable
|
||||
setUpdated = false
|
||||
isEpisode = Option.isSome post.episode
|
||||
media = episode.media
|
||||
length = episode.length
|
||||
duration = defaultArg (episode.duration |> Option.map (fun it -> it.ToString """hh\:mm\:ss""")) ""
|
||||
mediaType = defaultArg episode.mediaType ""
|
||||
imageUrl = defaultArg episode.imageUrl ""
|
||||
subtitle = defaultArg episode.subtitle ""
|
||||
explicit = defaultArg (episode.explicit |> Option.map ExplicitRating.toString) ""
|
||||
chapterFile = defaultArg episode.chapterFile ""
|
||||
chapterType = defaultArg episode.chapterType ""
|
||||
transcriptUrl = defaultArg episode.transcriptUrl ""
|
||||
transcriptType = defaultArg episode.transcriptType ""
|
||||
transcriptLang = defaultArg episode.transcriptLang ""
|
||||
transcriptCaptions = defaultArg episode.transcriptCaptions false
|
||||
seasonNumber = defaultArg episode.seasonNumber 0
|
||||
seasonDescription = defaultArg episode.seasonDescription ""
|
||||
episodeNumber = defaultArg (episode.episodeNumber |> Option.map string) ""
|
||||
episodeDescription = defaultArg episode.episodeDescription ""
|
||||
}
|
||||
|
||||
/// Update a post with values from the submitted form
|
||||
member this.updatePost (post : Post) (revision : Revision) now =
|
||||
{ post with
|
||||
title = this.title
|
||||
permalink = Permalink this.permalink
|
||||
publishedOn = if this.doPublish then Some now else post.publishedOn
|
||||
updatedOn = now
|
||||
text = MarkupText.toHtml revision.text
|
||||
tags = this.tags.Split ","
|
||||
|> Seq.ofArray
|
||||
|> Seq.map (fun it -> it.Trim().ToLower ())
|
||||
|> Seq.filter (fun it -> it <> "")
|
||||
|> Seq.sort
|
||||
|> List.ofSeq
|
||||
template = match this.template.Trim () with "" -> None | tmpl -> Some tmpl
|
||||
categoryIds = this.categoryIds |> Array.map CategoryId |> List.ofArray
|
||||
status = if this.doPublish then Published else post.status
|
||||
metadata = Seq.zip this.metaNames this.metaValues
|
||||
|> Seq.filter (fun it -> fst it > "")
|
||||
|> Seq.map (fun it -> { name = fst it; value = snd it })
|
||||
|> Seq.sortBy (fun it -> $"{it.name.ToLower ()} {it.value.ToLower ()}")
|
||||
|> List.ofSeq
|
||||
revisions = match post.revisions |> List.tryHead with
|
||||
| Some r when r.text = revision.text -> post.revisions
|
||||
| _ -> revision :: post.revisions
|
||||
episode =
|
||||
if this.isEpisode then
|
||||
Some {
|
||||
media = this.media
|
||||
length = this.length
|
||||
duration = noneIfBlank this.duration |> Option.map TimeSpan.Parse
|
||||
mediaType = noneIfBlank this.mediaType
|
||||
imageUrl = noneIfBlank this.imageUrl
|
||||
subtitle = noneIfBlank this.subtitle
|
||||
explicit = noneIfBlank this.explicit |> Option.map ExplicitRating.parse
|
||||
chapterFile = noneIfBlank this.chapterFile
|
||||
chapterType = noneIfBlank this.chapterType
|
||||
transcriptUrl = noneIfBlank this.transcriptUrl
|
||||
transcriptType = noneIfBlank this.transcriptType
|
||||
transcriptLang = noneIfBlank this.transcriptLang
|
||||
transcriptCaptions = if this.transcriptCaptions then Some true else None
|
||||
seasonNumber = if this.seasonNumber = 0 then None else Some this.seasonNumber
|
||||
seasonDescription = noneIfBlank this.seasonDescription
|
||||
episodeNumber = match noneIfBlank this.episodeNumber |> Option.map Double.Parse with
|
||||
| Some it when it = 0.0 -> None
|
||||
| Some it -> Some (double it)
|
||||
| None -> None
|
||||
episodeDescription = noneIfBlank this.episodeDescription
|
||||
}
|
||||
else
|
||||
None
|
||||
}
|
||||
|
||||
|
||||
@@ -613,6 +745,9 @@ type PostListItem =
|
||||
/// Tags for the post
|
||||
tags : string list
|
||||
|
||||
/// The podcast episode information for this post
|
||||
episode : Episode option
|
||||
|
||||
/// Metadata for the post
|
||||
metadata : MetaItem list
|
||||
}
|
||||
@@ -631,6 +766,7 @@ type PostListItem =
|
||||
text = if extra = "" then post.text else post.text.Replace ("href=\"/", $"href=\"{extra}/")
|
||||
categoryIds = post.categoryIds |> List.map CategoryId.toString
|
||||
tags = post.tags
|
||||
episode = post.episode
|
||||
metadata = post.metadata
|
||||
}
|
||||
|
||||
|
||||
@@ -223,7 +223,8 @@ let register () =
|
||||
Template.RegisterTag<UserLinksTag> "user_links"
|
||||
|
||||
[ // Domain types
|
||||
typeof<CustomFeed>; typeof<MetaItem>; typeof<Page>; typeof<RssOptions>; typeof<TagMap>; typeof<WebLog>
|
||||
typeof<CustomFeed>; typeof<Episode>; typeof<Episode option>; typeof<MetaItem>; typeof<Page>; typeof<RssOptions>
|
||||
typeof<TagMap>; typeof<WebLog>
|
||||
// View models
|
||||
typeof<DashboardModel>; typeof<DisplayCategory>; typeof<DisplayCustomFeed>; typeof<DisplayPage>
|
||||
typeof<EditCategoryModel>; typeof<EditCustomFeedModel>; typeof<EditPageModel>; typeof<EditPostModel>
|
||||
|
||||
@@ -440,6 +440,7 @@ let updateTheme : HttpHandler = fun next ctx -> task {
|
||||
do! themeFile.CopyToAsync stream
|
||||
do! loadThemeFromZip themeName stream true data
|
||||
do! ThemeAssetCache.refreshTheme (ThemeId themeName) data
|
||||
TemplateCache.invalidateTheme themeName
|
||||
do! addMessage ctx { UserMessage.success with message = "Theme updated successfully" }
|
||||
return! redirectToGet (WebLog.relativeUrl ctx.WebLog (Permalink "admin/dashboard")) next ctx
|
||||
| Ok _ ->
|
||||
|
||||
@@ -76,6 +76,9 @@ module private Namespace =
|
||||
/// iTunes elements
|
||||
let iTunes = "http://www.itunes.com/dtds/podcast-1.0.dtd"
|
||||
|
||||
/// Podcast Index (AKA "podcasting 2.0")
|
||||
let podcast = "https://podcastindex.org/namespace/1.0"
|
||||
|
||||
/// Enables chapters
|
||||
let psc = "http://podlove.org/simple-chapters/"
|
||||
|
||||
@@ -127,36 +130,23 @@ let private toFeedItem webLog (authors : MetaItem list) (cats : DisplayCategory[
|
||||
item
|
||||
|
||||
/// Add episode information to a podcast feed item
|
||||
let private addEpisode webLog (feed : CustomFeed) (post : Post) (item : SyndicationItem) =
|
||||
let podcast = Option.get feed.podcast
|
||||
let meta name = post.metadata |> List.tryFind (fun it -> it.name = name)
|
||||
let value (item : MetaItem) = item.value
|
||||
let private addEpisode webLog (podcast : PodcastOptions) (episode : Episode) (post : Post) (item : SyndicationItem) =
|
||||
// Convert non-absolute URLs to an absolute URL for this web log
|
||||
let toAbsolute (link : string) = if link.StartsWith "http" then link else WebLog.absoluteUrl webLog (Permalink link)
|
||||
let epMediaUrl =
|
||||
match (meta >> Option.get >> value) "episode_media_file" with
|
||||
match episode.media with
|
||||
| link when link.StartsWith "http" -> link
|
||||
| link when Option.isSome podcast.mediaBaseUrl -> $"{podcast.mediaBaseUrl.Value}{link}"
|
||||
| link -> WebLog.absoluteUrl webLog (Permalink link)
|
||||
let epMediaType =
|
||||
match meta "episode_media_type", podcast.defaultMediaType with
|
||||
| Some epType, _ -> Some epType.value
|
||||
| None, Some defType -> Some defType
|
||||
| _ -> None
|
||||
let epImageUrl =
|
||||
match defaultArg ((meta >> Option.map value) "episode_image") (Permalink.toString podcast.imageUrl) with
|
||||
| link when link.StartsWith "http" -> link
|
||||
| link -> WebLog.absoluteUrl webLog (Permalink link)
|
||||
let epExplicit =
|
||||
try
|
||||
(meta >> Option.map (value >> ExplicitRating.parse)) "episode_explicit"
|
||||
|> Option.defaultValue podcast.explicit
|
||||
|> ExplicitRating.toString
|
||||
with :? ArgumentException -> ExplicitRating.toString podcast.explicit
|
||||
let epMediaType = [ episode.mediaType; podcast.defaultMediaType ] |> List.tryFind Option.isSome |> Option.flatten
|
||||
let epImageUrl = defaultArg episode.imageUrl (Permalink.toString podcast.imageUrl) |> toAbsolute
|
||||
let epExplicit = defaultArg episode.explicit podcast.explicit |> ExplicitRating.toString
|
||||
|
||||
let xmlDoc = XmlDocument ()
|
||||
let enclosure =
|
||||
let it = xmlDoc.CreateElement "enclosure"
|
||||
it.SetAttribute ("url", epMediaUrl)
|
||||
meta "episode_media_length" |> Option.iter (fun len -> it.SetAttribute ("length", len.value))
|
||||
it.SetAttribute ("length", string episode.length)
|
||||
epMediaType |> Option.iter (fun typ -> it.SetAttribute ("type", typ))
|
||||
it
|
||||
let image =
|
||||
@@ -169,10 +159,57 @@ let private addEpisode webLog (feed : CustomFeed) (post : Post) (item : Syndicat
|
||||
item.ElementExtensions.Add ("creator", Namespace.dc, podcast.displayedAuthor)
|
||||
item.ElementExtensions.Add ("author", Namespace.iTunes, podcast.displayedAuthor)
|
||||
item.ElementExtensions.Add ("explicit", Namespace.iTunes, epExplicit)
|
||||
meta "episode_subtitle"
|
||||
|> Option.iter (fun it -> item.ElementExtensions.Add ("subtitle", Namespace.iTunes, it.value))
|
||||
meta "episode_duration"
|
||||
|> Option.iter (fun it -> item.ElementExtensions.Add ("duration", Namespace.iTunes, it.value))
|
||||
episode.subtitle |> Option.iter (fun it -> item.ElementExtensions.Add ("subtitle", Namespace.iTunes, it))
|
||||
episode.duration
|
||||
|> Option.iter (fun it -> item.ElementExtensions.Add ("duration", Namespace.iTunes, it.ToString """hh\:mm\:ss"""))
|
||||
|
||||
match episode.chapterFile with
|
||||
| Some chapters ->
|
||||
let url = toAbsolute chapters
|
||||
let typ =
|
||||
match episode.chapterType with
|
||||
| Some mime -> Some mime
|
||||
| None when chapters.EndsWith ".json" -> Some "application/json+chapters"
|
||||
| None -> None
|
||||
let elt = xmlDoc.CreateElement ("podcast", "chapters", Namespace.podcast)
|
||||
elt.SetAttribute ("url", url)
|
||||
typ |> Option.iter (fun it -> elt.SetAttribute ("type", it))
|
||||
item.ElementExtensions.Add elt
|
||||
| None -> ()
|
||||
|
||||
match episode.transcriptUrl with
|
||||
| Some transcript ->
|
||||
let url = toAbsolute transcript
|
||||
let elt = xmlDoc.CreateElement ("podcast", "transcript", Namespace.podcast)
|
||||
elt.SetAttribute ("url", url)
|
||||
elt.SetAttribute ("type", Option.get episode.transcriptType)
|
||||
episode.transcriptLang |> Option.iter (fun it -> elt.SetAttribute ("language", it))
|
||||
if defaultArg episode.transcriptCaptions false then
|
||||
elt.SetAttribute ("rel", "captions")
|
||||
item.ElementExtensions.Add elt
|
||||
| None -> ()
|
||||
|
||||
match episode.seasonNumber with
|
||||
| Some season ->
|
||||
match episode.seasonDescription with
|
||||
| Some desc ->
|
||||
let elt = xmlDoc.CreateElement ("podcast", "season", Namespace.podcast)
|
||||
elt.SetAttribute ("name", desc)
|
||||
elt.InnerText <- string season
|
||||
item.ElementExtensions.Add elt
|
||||
| None -> item.ElementExtensions.Add ("season", Namespace.podcast, string season)
|
||||
| None -> ()
|
||||
|
||||
match episode.episodeNumber with
|
||||
| Some epNumber ->
|
||||
match episode.episodeDescription with
|
||||
| Some desc ->
|
||||
let elt = xmlDoc.CreateElement ("podcast", "episode", Namespace.podcast)
|
||||
elt.SetAttribute ("name", desc)
|
||||
elt.InnerText <- string epNumber
|
||||
item.ElementExtensions.Add elt
|
||||
| None -> item.ElementExtensions.Add ("episode", Namespace.podcast, string epNumber)
|
||||
| None -> ()
|
||||
|
||||
if post.metadata |> List.exists (fun it -> it.name = "chapter") then
|
||||
try
|
||||
@@ -216,7 +253,12 @@ let private addPodcast webLog (rssFeed : SyndicationFeed) (feed : CustomFeed) =
|
||||
|
||||
let xmlDoc = XmlDocument ()
|
||||
|
||||
[ "dc", Namespace.dc; "itunes", Namespace.iTunes; "psc", Namespace.psc; "rawvoice", Namespace.rawVoice ]
|
||||
[ "dc", Namespace.dc
|
||||
"itunes", Namespace.iTunes
|
||||
"podcast", Namespace.podcast
|
||||
"psc", Namespace.psc
|
||||
"rawvoice", Namespace.rawVoice
|
||||
]
|
||||
|> List.iter (fun (alias, nsUrl) -> addNamespace rssFeed alias nsUrl)
|
||||
|
||||
let categorization =
|
||||
@@ -314,10 +356,9 @@ let createFeed (feedType : FeedType) posts : HttpHandler = fun next ctx -> backg
|
||||
|
||||
let toItem post =
|
||||
let item = toFeedItem webLog authors cats tagMaps post
|
||||
match podcast with
|
||||
| Some feed when post.metadata |> List.exists (fun it -> it.name = "episode_media_file") ->
|
||||
addEpisode webLog feed post item
|
||||
| Some _ ->
|
||||
match podcast, post.episode with
|
||||
| Some feed, Some episode -> addEpisode webLog (Option.get feed.podcast) episode post item
|
||||
| Some _, _ ->
|
||||
warn "Feed" ctx $"[{webLog.name} {Permalink.toString self}] \"{stripHtml post.title}\" has no media"
|
||||
item
|
||||
| _ -> item
|
||||
|
||||
@@ -2,6 +2,7 @@
|
||||
module MyWebLog.Handlers.Post
|
||||
|
||||
open System
|
||||
open System.Collections.Generic
|
||||
open MyWebLog
|
||||
|
||||
/// Parse a slug and page number from an "everything else" URL
|
||||
@@ -237,13 +238,19 @@ let edit postId : HttpHandler = fun next ctx -> task {
|
||||
let model = EditPostModel.fromPost webLog post
|
||||
return!
|
||||
Hash.FromAnonymousObject {|
|
||||
csrf = csrfToken ctx
|
||||
model = model
|
||||
metadata = Array.zip model.metaNames model.metaValues
|
||||
|> Array.mapi (fun idx (name, value) -> [| string idx; name; value |])
|
||||
page_title = title
|
||||
templates = templates
|
||||
categories = cats
|
||||
csrf = csrfToken ctx
|
||||
model = model
|
||||
metadata = Array.zip model.metaNames model.metaValues
|
||||
|> Array.mapi (fun idx (name, value) -> [| string idx; name; value |])
|
||||
page_title = title
|
||||
templates = templates
|
||||
categories = cats
|
||||
explicit_values = [|
|
||||
KeyValuePair.Create ("", "– Default –")
|
||||
KeyValuePair.Create (ExplicitRating.toString Yes, "Yes")
|
||||
KeyValuePair.Create (ExplicitRating.toString No, "No")
|
||||
KeyValuePair.Create (ExplicitRating.toString Clean, "Clean")
|
||||
|]
|
||||
|}
|
||||
|> viewForTheme "admin" "post-edit" next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
@@ -312,31 +319,7 @@ let save : HttpHandler = fun next ctx -> task {
|
||||
| "" -> post
|
||||
| link when link = model.permalink -> post
|
||||
| _ -> { post with priorPermalinks = post.permalink :: post.priorPermalinks }
|
||||
let post =
|
||||
{ post with
|
||||
title = model.title
|
||||
permalink = Permalink model.permalink
|
||||
publishedOn = if model.doPublish then Some now else post.publishedOn
|
||||
updatedOn = now
|
||||
text = MarkupText.toHtml revision.text
|
||||
tags = model.tags.Split ","
|
||||
|> Seq.ofArray
|
||||
|> Seq.map (fun it -> it.Trim().ToLower ())
|
||||
|> Seq.filter (fun it -> it <> "")
|
||||
|> Seq.sort
|
||||
|> List.ofSeq
|
||||
template = match model.template.Trim () with "" -> None | tmpl -> Some tmpl
|
||||
categoryIds = model.categoryIds |> Array.map CategoryId |> List.ofArray
|
||||
status = if model.doPublish then Published else post.status
|
||||
metadata = Seq.zip model.metaNames model.metaValues
|
||||
|> Seq.filter (fun it -> fst it > "")
|
||||
|> Seq.map (fun it -> { name = fst it; value = snd it })
|
||||
|> Seq.sortBy (fun it -> $"{it.name.ToLower ()} {it.value.ToLower ()}")
|
||||
|> List.ofSeq
|
||||
revisions = match post.revisions |> List.tryHead with
|
||||
| Some r when r.text = revision.text -> post.revisions
|
||||
| _ -> revision :: post.revisions
|
||||
}
|
||||
let post = model.updatePost post revision now
|
||||
let post =
|
||||
match model.setPublished with
|
||||
| true ->
|
||||
|
||||
@@ -275,7 +275,7 @@ module Backup =
|
||||
match! data.WebLog.findById archive.webLog.id with
|
||||
| Some webLog when defaultArg newUrlBase webLog.urlBase = webLog.urlBase ->
|
||||
do! data.WebLog.delete webLog.id
|
||||
return archive
|
||||
return { archive with webLog = { archive.webLog with urlBase = defaultArg newUrlBase webLog.urlBase } }
|
||||
| Some _ ->
|
||||
// Err'body gets new IDs...
|
||||
let newWebLogId = WebLogId.create ()
|
||||
|
||||
@@ -10,7 +10,7 @@
|
||||
</PropertyGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<Content Include="appsettings.json" CopyToOutputDirectory="Always" />
|
||||
<Content Include="appsettings*.json" CopyToOutputDirectory="Always" />
|
||||
<Compile Include="Caches.fs" />
|
||||
<Compile Include="Handlers\Error.fs" />
|
||||
<Compile Include="Handlers\Helpers.fs" />
|
||||
|
||||
@@ -130,7 +130,8 @@ let rec main args =
|
||||
| Some it when it = "import-links" -> Maintenance.importLinks args app.Services
|
||||
| Some it when it = "load-theme" -> Maintenance.loadTheme args app.Services
|
||||
| Some it when it = "backup" -> Maintenance.Backup.generateBackup args app.Services
|
||||
| Some it when it = "restore" -> Maintenance.Backup.restoreFromBackup args app.Services
|
||||
| Some it when it = "restore" -> Maintenance.Backup.restoreFromBackup args app.Services
|
||||
| Some it when it = "do-restore" -> Maintenance.Backup.restoreFromBackup args app.Services
|
||||
| _ ->
|
||||
let _ = app.UseForwardedHeaders ()
|
||||
let _ = app.UseCookiePolicy (CookiePolicyOptions (MinimumSameSitePolicy = SameSiteMode.Strict))
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
{
|
||||
"Generator": "myWebLog 2.0-beta01",
|
||||
"Generator": "myWebLog 2.0-beta02",
|
||||
"Logging": {
|
||||
"LogLevel": {
|
||||
"MyWebLog.Handlers": "Information"
|
||||
|
||||
@@ -22,12 +22,14 @@
|
||||
</div>
|
||||
<div class="mb-2">
|
||||
<label for="text">Text</label>
|
||||
<input type="radio" name="source" id="source_html" class="btn-check" value="HTML"
|
||||
{%- if model.source == "HTML" %} checked="checked"{% endif %}>
|
||||
<label class="btn btn-sm btn-outline-secondary" for="source_html">HTML</label>
|
||||
<input type="radio" name="source" id="source_md" class="btn-check" value="Markdown"
|
||||
{%- if model.source == "Markdown" %} checked="checked"{% endif %}>
|
||||
<label class="btn btn-sm btn-outline-secondary" for="source_md">Markdown</label>
|
||||
<div class="btn-group btn-group-sm" role="group" aria-label="Text format button group">
|
||||
<input type="radio" name="source" id="source_html" class="btn-check" value="HTML"
|
||||
{%- if model.source == "HTML" %} checked="checked"{% endif %}>
|
||||
<label class="btn btn-sm btn-outline-secondary" for="source_html">HTML</label>
|
||||
<input type="radio" name="source" id="source_md" class="btn-check" value="Markdown"
|
||||
{%- if model.source == "Markdown" %} checked="checked"{% endif %}>
|
||||
<label class="btn btn-sm btn-outline-secondary" for="source_md">Markdown</label>
|
||||
</div>
|
||||
</div>
|
||||
<div class="pb-3">
|
||||
<textarea name="text" id="text" class="form-control" rows="20">{{ model.text }}</textarea>
|
||||
@@ -39,13 +41,198 @@
|
||||
<div class="form-text">comma-delimited</div>
|
||||
</div>
|
||||
{% if model.status == "Draft" %}
|
||||
<div class="form-check pb-2">
|
||||
<div class="form-check form-switch pb-2">
|
||||
<input type="checkbox" name="doPublish" id="doPublish" class="form-check-input" value="true">
|
||||
<label for="doPublish" class="form-check-label">Publish This Post</label>
|
||||
</div>
|
||||
{% endif %}
|
||||
<button type="submit" class="btn btn-primary pb-2">Save Changes</button>
|
||||
<hr class="mb-3">
|
||||
<fieldset class="mb-3">
|
||||
<legend>
|
||||
<span class="form-check form-switch">
|
||||
<small>
|
||||
<input type="checkbox" name="isEpisode" id="isEpisode" class="form-check-input" value="true"
|
||||
data-bs-toggle="collapse" data-bs-target="#episodeItems" onclick="Admin.toggleEpisodeFields()"
|
||||
{%- if model.is_episode %}checked="checked"{% endif %}>
|
||||
</small>
|
||||
<label for="isEpisode">Podcast Episode</label>
|
||||
</span>
|
||||
</legend>
|
||||
<div id="episodeItems" class="container p-0 collapse{% if model.is_episode %} show{% endif %}">
|
||||
<div class="row">
|
||||
<div class="col-12 col-md-8 pb-3">
|
||||
<div class="form-floating">
|
||||
<input type="text" name="media" id="media" class="form-control" placeholder="Media" required
|
||||
value="{{ model.media }}">
|
||||
<label for="media">Media File</label>
|
||||
<div class="form-text">
|
||||
Relative URL will be appended to base media path (if set) or served from this web log
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
<div class="col-12 col-md-4 pb-3">
|
||||
<div class="form-floating">
|
||||
<input type="text" name="mediaType" id="mediaType" class="form-control" placeholder="Media Type"
|
||||
value="{{ model.media_type }}">
|
||||
<label for="mediaType">Media MIME Type</label>
|
||||
<div class="form-text">Optional; overrides podcast default</div>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
<div class="row pb-3">
|
||||
<div class="col">
|
||||
<div class="form-floating">
|
||||
<input type="number" name="length" id="length" class="form-control" placeholder="Length" required
|
||||
value="{{ model.length }}">
|
||||
<label for="length">Media Length (bytes)</label>
|
||||
<div class="form-text">TODO: derive from above file name</div>
|
||||
</div>
|
||||
</div>
|
||||
<div class="col">
|
||||
<div class="form-floating">
|
||||
<input type="text" name="duration" id="duration" class="form-control" placeholder="Duration"
|
||||
value="{{ model.duration }}">
|
||||
<label for="duration">Duration</label>
|
||||
<div class="form-text">Recommended; enter in <code>HH:MM:SS</code> format</div>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
<div class="row pb-3">
|
||||
<div class="col">
|
||||
<div class="form-floating">
|
||||
<input type="text" name="subtitle" id="subtitle" class="form-control" placeholder="Subtitle"
|
||||
value="{{ model.subtitle }}">
|
||||
<label for="subtitle">Subtitle</label>
|
||||
<div class="form-text">Optional; a subtitle for this episode</div>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
<div class="row">
|
||||
<div class="col-12 col-md-8 pb-3">
|
||||
<div class="form-floating">
|
||||
<input type="text" name="imageUrl" id="imageUrl" class="form-control" placeholder="Image URL"
|
||||
value="{{ model.image_url }}">
|
||||
<label for="imageUrl">Image URL</label>
|
||||
<div class="form-text">
|
||||
Optional; overrides podcast default; relative URL served from this web log
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
<div class="col-12 col-md-4 pb-3">
|
||||
<div class="form-floating">
|
||||
<select name="explicit" id="explicit" class="form-control">
|
||||
{% for exp_value in explicit_values %}
|
||||
<option value="{{ exp_value[0] }}"
|
||||
{%- if model.explicit == exp_value[0] %} selected="selected"{% endif -%}>
|
||||
{{ exp_value[1] }}
|
||||
</option>
|
||||
{% endfor %}
|
||||
</select>
|
||||
<label for="explicit">Explicit Rating</label>
|
||||
<div class="form-text">Optional; overrides podcast default</div>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
<div class="row">
|
||||
<div class="col-12 col-md-8 pb-3">
|
||||
<div class="form-floating">
|
||||
<input type="text" name="chapterFile" id="chapterFile" class="form-control"
|
||||
placeholder="Chapter File" value="{{ model.chapter_file }}">
|
||||
<label for="chapterFile">Chapter File</label>
|
||||
<div class="form-text">Optional; relative URL served from this web log</div>
|
||||
</div>
|
||||
</div>
|
||||
<div class="col-12 col-md-4 pb-3">
|
||||
<div class="form-floating">
|
||||
<input type="text" name="chapterType" id="chapterType" class="form-control"
|
||||
placeholder="Chapter Type" value="{{ model.chapter_type }}">
|
||||
<label for="chapterType">Chapter MIME Type</label>
|
||||
<div class="form-text">
|
||||
Optional; <code>application/json+chapters</code> assumed if chapter file ends with
|
||||
<code>.json</code>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
<div class="row">
|
||||
<div class="col-12 col-md-8 pb-3">
|
||||
<div class="form-floating">
|
||||
<input type="text" name="transcriptUrl" id="transcriptUrl" class="form-control"
|
||||
placeholder="Transcript URL" value="{{ model.transcript_url }}"
|
||||
onkeyup="Admin.requireTranscriptType()">
|
||||
<label for="transcriptUrl">Transcript URL</label>
|
||||
<div class="form-text">Optional; relative URL served from this web log</div>
|
||||
</div>
|
||||
</div>
|
||||
<div class="col-12 col-md-4 pb-3">
|
||||
<div class="form-floating">
|
||||
<input type="text" name="transcriptType" id="transcriptType" class="form-control"
|
||||
placeholder="Transcript Type" value="{{ model.transcript_type }}"
|
||||
{%- if model.transcript_url != "" %} required{% endif %}>
|
||||
<label for="transcriptType">Transcript MIME Type</label>
|
||||
<div class="form-text">Required if transcript URL provided</div>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
<div class="row pb-3">
|
||||
<div class="col">
|
||||
<div class="form-floating">
|
||||
<input type="text" name="transcriptLang" id="transcriptLang" class="form-control"
|
||||
placeholder="Transcript Language" value="{{ model.transcript_lang }}">
|
||||
<label for="transcriptLang">Transcript Language</label>
|
||||
<div class="form-text">Optional; overrides podcast default</div>
|
||||
</div>
|
||||
</div>
|
||||
<div class="col d-flex justify-content-center">
|
||||
<div class="form-check form-switch align-self-center pb-3">
|
||||
<input type="checkbox" name="transcriptCaptions" id="transcriptCaptions" class="form-check-input"
|
||||
value="true" {% if model.transcript_captions %} checked="checked"{% endif %}>
|
||||
<label for="transcriptCaptions">This is a captions file</label>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
<div class="row pb-3">
|
||||
<div class="col col-md-4">
|
||||
<div class="form-floating">
|
||||
<input type="number" name="seasonNumber" id="seasonNumber" class="form-control"
|
||||
placeholder="Season Number" value="{{ model.season_number }}">
|
||||
<label for="seasonNumber">Season Number</label>
|
||||
<div class="form-text">Optional</div>
|
||||
</div>
|
||||
</div>
|
||||
<div class="col col-md-8">
|
||||
<div class="form-floating">
|
||||
<input type="text" name="seasonDescription" id="seasonDescription" class="form-control"
|
||||
placeholder="Season Description" maxlength="128" value="{{ model.season_description }}">
|
||||
<label for="seasonDescription">Season Description</label>
|
||||
<div class="form-text">Optional</div>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
<div class="row pb-3">
|
||||
<div class="col col-md-4">
|
||||
<div class="form-floating">
|
||||
<input type="number" name="episodeNumber" id="episodeNumber" class="form-control" step="0.01"
|
||||
placeholder="Episode Number" value="{{ model.episode_number }}">
|
||||
<label for="episodeNumber">Episode Number</label>
|
||||
<div class="form-text">Optional; up to 2 decimal points</div>
|
||||
</div>
|
||||
</div>
|
||||
<div class="col col-md-8">
|
||||
<div class="form-floating">
|
||||
<input type="text" name="episodeDescription" id="episodeDescription" class="form-control"
|
||||
placeholder="Episode Description" maxlength="128" value="{{ model.episode_description }}">
|
||||
<label for="episodeDescription">Episode Description</label>
|
||||
<div class="form-text">Optional</div>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
</div>
|
||||
<script>
|
||||
document.addEventListener("DOMContentLoaded", () => Admin.toggleEpisodeFields())
|
||||
</script>
|
||||
</fieldset>
|
||||
<fieldset class="pb-3">
|
||||
<legend>
|
||||
Metadata
|
||||
@@ -55,11 +242,6 @@
|
||||
</button>
|
||||
</legend>
|
||||
<div id="metaItemContainer" class="collapse">
|
||||
{%- unless model.meta_names contains "episode_media_file" %}
|
||||
<button class="btn btn-sm btn-secondary" onclick="Admin.addPodcastFields()" id="addPodcastFieldButton">
|
||||
Add Podcast Episode Fields
|
||||
</button>
|
||||
{%- endunless %}
|
||||
<div id="metaItems" class="container">
|
||||
{%- for meta in metadata %}
|
||||
<div id="meta_{{ meta[0] }}" class="row mb-3">
|
||||
|
||||
@@ -42,10 +42,7 @@
|
||||
</span>
|
||||
</div>
|
||||
<div class="{{ title_col }}">
|
||||
{%- assign media = post.metadata | value: "episode_media_file" -%}
|
||||
{%- unless media == "-- episode_media_file not found --" -%}
|
||||
<span class="badge bg-success float-end text-uppercase">Episode</span>
|
||||
{%- endunless -%}
|
||||
{%- if post.episode %}<span class="badge bg-success float-end text-uppercase">Episode</span>{% endif -%}
|
||||
{{ post.title }}<br>
|
||||
<small>
|
||||
<a href="{{ post | relative_link }}" target="_blank">View Post</a>
|
||||
|
||||
@@ -1,2 +1,2 @@
|
||||
myWebLog Admin
|
||||
2.0.0-alpha34
|
||||
2.0.0-beta02
|
||||
@@ -204,32 +204,16 @@
|
||||
},
|
||||
|
||||
/**
|
||||
* Add podcast episode metadata fields
|
||||
* Enable or disable podcast fields
|
||||
*/
|
||||
addPodcastFields() {
|
||||
[ [ "episode_media_file", true, "required; relative URL will be appended to configured base media path" ],
|
||||
[ "episode_media_length", true, "required; file size in bytes" ],
|
||||
[ "episode_duration", false, "suggested; format is HH:MM:SS" ],
|
||||
[ "episode_media_type", false, "optional; blank uses podcast default" ],
|
||||
[ "episode_image", false, "optional; relative URLs are served from this web log" ],
|
||||
[ "episode_subtitle", false, "optional" ],
|
||||
[ "episode_explicit", false, "optional; blank uses podcast default"]
|
||||
].forEach(([fieldName, isRequired, hintText]) => {
|
||||
const nameField = this.createMetaNameField()
|
||||
nameField.value = fieldName
|
||||
nameField.readOnly = true
|
||||
|
||||
const valueField = this.createMetaValueField()
|
||||
valueField.required = isRequired
|
||||
|
||||
this.createMetaRow(
|
||||
this.createMetaRemoveColumn(),
|
||||
this.createMetaNameColumn(nameField),
|
||||
this.createMetaValueColumn(valueField, hintText))
|
||||
})
|
||||
document.getElementById("addPodcastFieldButton").remove()
|
||||
toggleEpisodeFields() {
|
||||
const disabled = !document.getElementById("isEpisode").checked
|
||||
;[ "media", "mediaType", "length", "duration", "subtitle", "imageUrl", "explicit", "chapterFile", "chapterType",
|
||||
"transcriptUrl", "transcriptType", "transcriptLang", "transcriptCaptions", "seasonNumber", "seasonDescription",
|
||||
"episodeNumber", "episodeDescription"
|
||||
].forEach(it => document.getElementById(it).disabled = disabled)
|
||||
},
|
||||
|
||||
|
||||
/**
|
||||
* Check to enable or disable podcast fields
|
||||
*/
|
||||
@@ -271,6 +255,13 @@
|
||||
document.getElementById(`link_${idx}`).remove()
|
||||
},
|
||||
|
||||
/**
|
||||
* Require transcript type if transcript URL is present
|
||||
*/
|
||||
requireTranscriptType() {
|
||||
document.getElementById("transcriptType").required = document.getElementById("transcriptUrl").value.trim() !== ""
|
||||
},
|
||||
|
||||
/**
|
||||
* Show messages that may have come with an htmx response
|
||||
* @param messages The messages from the response
|
||||
|
||||
Reference in New Issue
Block a user