Version 2.1 (#41)
- Add full chapter support (#6) - Add built-in redirect functionality (#39) - Support building Docker containers for release (#38) - Support canonical domain configuration (#37) - Add unit tests for domain/models and integration tests for all three data stores - Convert SQLite storage to use JSON documents, similar to PostgreSQL - Convert admin templates to Giraffe View Engine (from Liquid) - Add .NET 8 support
This commit was merged in pull request #41.
This commit is contained in:
@@ -1,141 +1,69 @@
|
||||
namespace MyWebLog.Data.SQLite
|
||||
|
||||
open System.Threading.Tasks
|
||||
open BitBadger.Documents
|
||||
open BitBadger.Documents.Sqlite
|
||||
open Microsoft.Data.Sqlite
|
||||
open Microsoft.Extensions.Logging
|
||||
open MyWebLog
|
||||
open MyWebLog.Data
|
||||
|
||||
/// SQLite myWebLog theme data implementation
|
||||
type SQLiteThemeData (conn : SqliteConnection) =
|
||||
/// SQLite myWebLog theme data implementation
|
||||
type SQLiteThemeData(conn : SqliteConnection, log: ILogger) =
|
||||
|
||||
/// The JSON field for the theme ID
|
||||
let idField = $"data ->> '{nameof Theme.Empty.Id}'"
|
||||
|
||||
/// Convert a document to a theme with no template text
|
||||
let withoutTemplateText (rdr: SqliteDataReader) =
|
||||
let theme = fromData<Theme> rdr
|
||||
{ theme with Templates = theme.Templates |> List.map (fun t -> { t with Text = "" })}
|
||||
|
||||
/// Remove the template text from a theme
|
||||
let withoutTemplateText' (it: Theme) =
|
||||
{ it with Templates = it.Templates |> List.map (fun t -> { t with Text = "" }) }
|
||||
|
||||
/// Retrieve all themes (except 'admin'; excludes template text)
|
||||
let all () = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT * FROM theme WHERE id <> 'admin' ORDER BY id"
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
let themes = toList Map.toTheme rdr
|
||||
do! rdr.CloseAsync ()
|
||||
cmd.CommandText <- "SELECT name, theme_id FROM theme_template WHERE theme_id <> 'admin' ORDER BY name"
|
||||
use! rdr = cmd.ExecuteReaderAsync ()
|
||||
let templates =
|
||||
seq { while rdr.Read () do ThemeId (Map.getString "theme_id" rdr), Map.toThemeTemplate false rdr }
|
||||
|> List.ofSeq
|
||||
return
|
||||
themes
|
||||
|> List.map (fun t ->
|
||||
{ t with Templates = templates |> List.filter (fun (themeId, _) -> themeId = t.Id) |> List.map snd })
|
||||
}
|
||||
let all () =
|
||||
log.LogTrace "Theme.all"
|
||||
conn.customList
|
||||
$"{Query.selectFromTable Table.Theme} WHERE {idField} <> 'admin' ORDER BY {idField}"
|
||||
[]
|
||||
withoutTemplateText
|
||||
|
||||
/// Does a given theme exist?
|
||||
let exists themeId = backgroundTask {
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <- "SELECT COUNT(id) FROM theme WHERE id = @id"
|
||||
cmd.Parameters.AddWithValue ("@id", ThemeId.toString themeId) |> ignore
|
||||
let! count = count cmd
|
||||
return count > 0
|
||||
}
|
||||
let exists (themeId: ThemeId) =
|
||||
log.LogTrace "Theme.exists"
|
||||
conn.existsById Table.Theme themeId
|
||||
|
||||
/// 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 true) templateRdr }
|
||||
else
|
||||
return None
|
||||
}
|
||||
let findById themeId =
|
||||
log.LogTrace "Theme.findById"
|
||||
conn.findById<ThemeId, Theme> Table.Theme themeId
|
||||
|
||||
/// 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
|
||||
}
|
||||
let findByIdWithoutText (themeId: ThemeId) =
|
||||
log.LogTrace "Theme.findByIdWithoutText"
|
||||
conn.customSingle (Query.Find.byId Table.Theme) [ idParam themeId ] withoutTemplateText
|
||||
|
||||
/// Delete a theme by its ID
|
||||
let delete themeId = backgroundTask {
|
||||
log.LogTrace "Theme.delete"
|
||||
match! findByIdWithoutText themeId with
|
||||
| Some _ ->
|
||||
use cmd = conn.CreateCommand ()
|
||||
cmd.CommandText <-
|
||||
"DELETE FROM theme_asset WHERE theme_id = @id;
|
||||
DELETE FROM theme_template WHERE theme_id = @id;
|
||||
DELETE FROM theme WHERE id = @id"
|
||||
cmd.Parameters.AddWithValue ("@id", ThemeId.toString themeId) |> ignore
|
||||
do! write cmd
|
||||
do! conn.customNonQuery
|
||||
$"DELETE FROM {Table.ThemeAsset} WHERE theme_id = @id; {Query.Delete.byId Table.Theme}"
|
||||
[ idParam themeId ]
|
||||
return true
|
||||
| None -> return false
|
||||
}
|
||||
|
||||
/// 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 =
|
||||
Utils.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
|
||||
}
|
||||
let save (theme: Theme) =
|
||||
log.LogTrace "Theme.save"
|
||||
conn.save Table.Theme theme
|
||||
|
||||
interface IThemeData with
|
||||
member _.All () = all ()
|
||||
member _.All() = all ()
|
||||
member _.Delete themeId = delete themeId
|
||||
member _.Exists themeId = exists themeId
|
||||
member _.FindById themeId = findById themeId
|
||||
@@ -145,97 +73,75 @@ type SQLiteThemeData (conn : SqliteConnection) =
|
||||
|
||||
open System.IO
|
||||
|
||||
/// SQLite myWebLog theme data implementation
|
||||
type SQLiteThemeAssetData (conn : SqliteConnection) =
|
||||
/// SQLite myWebLog theme data implementation
|
||||
type SQLiteThemeAssetData(conn : SqliteConnection, log: ILogger) =
|
||||
|
||||
/// Create parameters for a theme asset ID
|
||||
let assetIdParams assetId =
|
||||
let (ThemeAssetId (ThemeId themeId, path)) = assetId
|
||||
[ idParam themeId; sqlParam "@path" path ]
|
||||
|
||||
/// 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
|
||||
}
|
||||
let all () =
|
||||
log.LogTrace "ThemeAsset.all"
|
||||
conn.customList $"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset}" [] (Map.toThemeAsset false)
|
||||
|
||||
/// 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
|
||||
}
|
||||
let deleteByTheme (themeId: ThemeId) =
|
||||
log.LogTrace "ThemeAsset.deleteByTheme"
|
||||
conn.customNonQuery $"DELETE FROM {Table.ThemeAsset} WHERE theme_id = @id" [ idParam themeId ]
|
||||
|
||||
/// 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
|
||||
}
|
||||
let findById assetId =
|
||||
log.LogTrace "ThemeAsset.findById"
|
||||
conn.customSingle
|
||||
$"SELECT *, ROWID FROM {Table.ThemeAsset} WHERE theme_id = @id AND path = @path"
|
||||
(assetIdParams assetId)
|
||||
(Map.toThemeAsset true)
|
||||
|
||||
/// 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
|
||||
}
|
||||
let findByTheme (themeId: ThemeId) =
|
||||
log.LogTrace "ThemeAsset.findByTheme"
|
||||
conn.customList
|
||||
$"SELECT theme_id, path, updated_on FROM {Table.ThemeAsset} WHERE theme_id = @id"
|
||||
[ idParam themeId ]
|
||||
(Map.toThemeAsset false)
|
||||
|
||||
/// 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
|
||||
}
|
||||
let findByThemeWithData (themeId: ThemeId) =
|
||||
log.LogTrace "ThemeAsset.findByThemeWithData"
|
||||
conn.customList
|
||||
$"SELECT *, ROWID FROM {Table.ThemeAsset} WHERE theme_id = @id"
|
||||
[ idParam themeId ]
|
||||
(Map.toThemeAsset true)
|
||||
|
||||
/// 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 (
|
||||
let save (asset: ThemeAsset) = backgroundTask {
|
||||
log.LogTrace "ThemeAsset.save"
|
||||
do! conn.customNonQuery
|
||||
$"INSERT INTO {Table.ThemeAsset} (
|
||||
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", instantParam asset.UpdatedOn)
|
||||
cmd.Parameters.AddWithValue ("@dataLength", asset.Data.Length)
|
||||
] |> ignore
|
||||
do! write cmd
|
||||
) VALUES (
|
||||
@id, @path, @updatedOn, ZEROBLOB(@dataLength)
|
||||
) ON CONFLICT (theme_id, path) DO UPDATE
|
||||
SET updated_on = @updatedOn,
|
||||
data = ZEROBLOB(@dataLength)"
|
||||
[ sqlParam "@updatedOn" (instantParam asset.UpdatedOn)
|
||||
sqlParam "@dataLength" asset.Data.Length
|
||||
yield! (assetIdParams asset.Id) ]
|
||||
|
||||
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)
|
||||
let! rowId =
|
||||
conn.customScalar
|
||||
$"SELECT ROWID FROM {Table.ThemeAsset} WHERE theme_id = @id AND path = @path"
|
||||
(assetIdParams asset.Id)
|
||||
_.GetInt64(0)
|
||||
use dataStream = new MemoryStream(asset.Data)
|
||||
use blobStream = new SqliteBlob(conn, Table.ThemeAsset, "data", rowId)
|
||||
do! dataStream.CopyToAsync blobStream
|
||||
}
|
||||
|
||||
interface IThemeAssetData with
|
||||
member _.All () = all ()
|
||||
member _.All() = all ()
|
||||
member _.DeleteByTheme themeId = deleteByTheme themeId
|
||||
member _.FindById assetId = findById assetId
|
||||
member _.FindByTheme themeId = findByTheme themeId
|
||||
|
||||
Reference in New Issue
Block a user