Reorganize SQLite data files
- Add episode data structure (#9) - Add fields for chapters (#6) and transcripts (#8) - Add fields for medium (#3), funding (#7), and GUID (#4) - Fix RethinkDB restore problems (#10) - Save custom feeds in SQLite (#11)
This commit is contained in:
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
|
||||
Reference in New Issue
Block a user