Compare commits
8 Commits
main
...
version-th
Author | SHA1 | Date | |
---|---|---|---|
870f87cb17 | |||
0032d15c0a | |||
95be82cc84 | |||
d047035173 | |||
cc3e41ddc5 | |||
d4c0e4e26c | |||
fbc4e891bd | |||
cd450a05e5 |
@ -5,17 +5,17 @@
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
<PackageReference Include="BitBadger.Documents.Postgres" Version="3.1.0" />
|
||||
<PackageReference Include="BitBadger.Documents.Sqlite" Version="3.1.0" />
|
||||
<PackageReference Include="Microsoft.Data.Sqlite" Version="8.0.6" />
|
||||
<PackageReference Include="BitBadger.Documents.Postgres" Version="4.0.0-rc5" />
|
||||
<PackageReference Include="BitBadger.Documents.Sqlite" Version="4.0.0-rc5" />
|
||||
<PackageReference Include="Microsoft.Data.Sqlite" Version="8.0.8" />
|
||||
<PackageReference Include="Microsoft.Extensions.Caching.Abstractions" Version="8.0.0" />
|
||||
<PackageReference Include="Microsoft.Extensions.Configuration.Abstractions" Version="8.0.0" />
|
||||
<PackageReference Include="Microsoft.FSharpLu.Json" Version="0.11.7" />
|
||||
<PackageReference Include="NodaTime.Serialization.JsonNet" Version="3.1.0" />
|
||||
<PackageReference Include="Npgsql.NodaTime" Version="8.0.3" />
|
||||
<PackageReference Include="Npgsql.NodaTime" Version="8.0.4" />
|
||||
<PackageReference Include="RethinkDb.Driver" Version="2.3.150" />
|
||||
<PackageReference Include="RethinkDb.Driver.FSharp" Version="0.9.0-beta-07" />
|
||||
<PackageReference Update="FSharp.Core" Version="8.0.300" />
|
||||
<PackageReference Update="FSharp.Core" Version="8.0.400" />
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
|
@ -19,38 +19,41 @@ type PostgresCategoryData(log: ILogger) =
|
||||
let countTopLevel webLogId =
|
||||
log.LogTrace "Category.countTopLevel"
|
||||
Custom.scalar
|
||||
$"""{Query.Count.byContains Table.Category}
|
||||
AND {Query.whereByField (Field.NEX (nameof Category.Empty.ParentId)) ""}"""
|
||||
$"""{Query.byContains (Query.count Table.Category)}
|
||||
AND {Query.whereByFields Any [ Field.NotExists (nameof Category.Empty.ParentId) ]}"""
|
||||
[ webLogContains webLogId ]
|
||||
toCount
|
||||
|
||||
/// Find all categories for the given web log
|
||||
let findByWebLog webLogId =
|
||||
log.LogTrace "Category.findByWebLog"
|
||||
Find.byContains<Category> Table.Category (webLogDoc webLogId)
|
||||
|
||||
/// Retrieve all categories for the given web log in a DotLiquid-friendly format
|
||||
let findAllForView webLogId = backgroundTask {
|
||||
log.LogTrace "Category.findAllForView"
|
||||
let! cats =
|
||||
Custom.list
|
||||
$"{selectWithCriteria Table.Category} ORDER BY LOWER(data ->> '{nameof Category.Empty.Name}')"
|
||||
[ webLogContains webLogId ]
|
||||
fromData<Category>
|
||||
let ordered = Utils.orderByHierarchy cats None None []
|
||||
let counts =
|
||||
let! cats = findByWebLog webLogId
|
||||
let ordered = Utils.orderByHierarchy (cats |> List.sortBy _.Name.ToLowerInvariant()) None None []
|
||||
let counts =
|
||||
ordered
|
||||
|> Seq.map (fun it ->
|
||||
// Parent category post counts include posts in subcategories
|
||||
let catIdSql, catIdParams =
|
||||
let catIdField =
|
||||
ordered
|
||||
|> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name)
|
||||
|> Seq.map _.Id
|
||||
|> Seq.append (Seq.singleton it.Id)
|
||||
|> List.ofSeq
|
||||
|> arrayContains (nameof Post.Empty.CategoryIds) id
|
||||
|> Field.InArray (nameof Post.Empty.CategoryIds) Table.Post
|
||||
let query =
|
||||
(Query.statementWhere
|
||||
(Query.count Table.Post)
|
||||
$"""{Query.whereDataContains "@criteria"} AND {Query.whereByFields All [ catIdField ]}""")
|
||||
.Replace("(*)", $"(DISTINCT data->>'{nameof Post.Empty.Id}')")
|
||||
let postCount =
|
||||
Custom.scalar
|
||||
$"""SELECT COUNT(DISTINCT data ->> '{nameof Post.Empty.Id}') AS it
|
||||
FROM {Table.Post}
|
||||
WHERE {Query.whereDataContains "@criteria"}
|
||||
AND {catIdSql}"""
|
||||
[ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |}; catIdParams ]
|
||||
query
|
||||
(addFieldParams
|
||||
[ catIdField ] [ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |} ])
|
||||
toCount
|
||||
|> Async.AwaitTask
|
||||
|> Async.RunSynchronously
|
||||
@ -71,11 +74,6 @@ type PostgresCategoryData(log: ILogger) =
|
||||
log.LogTrace "Category.findById"
|
||||
Document.findByIdAndWebLog<CategoryId, Category> Table.Category catId webLogId
|
||||
|
||||
/// Find all categories for the given web log
|
||||
let findByWebLog webLogId =
|
||||
log.LogTrace "Category.findByWebLog"
|
||||
Document.findByWebLog<Category> Table.Category webLogId
|
||||
|
||||
/// Delete a category
|
||||
let delete catId webLogId = backgroundTask {
|
||||
log.LogTrace "Category.delete"
|
||||
@ -87,14 +85,14 @@ type PostgresCategoryData(log: ILogger) =
|
||||
if hasChildren then
|
||||
let childQuery, childParams =
|
||||
if cat.ParentId.IsSome then
|
||||
Query.Patch.byId Table.Category,
|
||||
Query.byId (Query.patch Table.Category) "",
|
||||
children
|
||||
|> List.map (fun child -> [ idParam child.Id; jsonParam "@data" {| ParentId = cat.ParentId |} ])
|
||||
else
|
||||
Query.RemoveFields.byId Table.Category,
|
||||
Query.byId (Query.removeFields Table.Category) "",
|
||||
children
|
||||
|> List.map (fun child ->
|
||||
[ idParam child.Id; fieldNameParam [ nameof Category.Empty.ParentId ] ])
|
||||
[ idParam child.Id; fieldNameParams [ nameof Category.Empty.ParentId ] ])
|
||||
let! _ =
|
||||
Configuration.dataSource ()
|
||||
|> Sql.fromDataSource
|
||||
@ -103,7 +101,7 @@ type PostgresCategoryData(log: ILogger) =
|
||||
// Delete the category off all posts where it is assigned
|
||||
let! posts =
|
||||
Custom.list
|
||||
$"SELECT data FROM {Table.Post} WHERE data -> '{nameof Post.Empty.CategoryIds}' @> @id"
|
||||
$"SELECT data FROM {Table.Post} WHERE data->'{nameof Post.Empty.CategoryIds}' @> @id"
|
||||
[ jsonParam "@id" [| string catId |] ]
|
||||
fromData<Post>
|
||||
if not (List.isEmpty posts) then
|
||||
@ -111,7 +109,7 @@ type PostgresCategoryData(log: ILogger) =
|
||||
Configuration.dataSource ()
|
||||
|> Sql.fromDataSource
|
||||
|> Sql.executeTransactionAsync
|
||||
[ Query.Patch.byId Table.Post,
|
||||
[ Query.byId (Query.patch Table.Post) "",
|
||||
posts
|
||||
|> List.map (fun post ->
|
||||
[ idParam post.Id
|
||||
|
@ -83,28 +83,7 @@ let webLogContains webLogId =
|
||||
|
||||
/// A SQL string to select data from a table with the given JSON document contains criteria
|
||||
let selectWithCriteria tableName =
|
||||
$"""{Query.selectFromTable tableName} WHERE {Query.whereDataContains "@criteria"}"""
|
||||
|
||||
/// Create the SQL and parameters for an IN clause
|
||||
let inClause<'T> colNameAndPrefix paramName (items: 'T list) =
|
||||
if List.isEmpty items then "", []
|
||||
else
|
||||
let mutable idx = 0
|
||||
items
|
||||
|> List.skip 1
|
||||
|> List.fold (fun (itemS, itemP) it ->
|
||||
idx <- idx + 1
|
||||
$"{itemS}, @%s{paramName}{idx}", ($"@%s{paramName}{idx}", Sql.string (string it)) :: itemP)
|
||||
(Seq.ofList items
|
||||
|> Seq.map (fun it ->
|
||||
$"%s{colNameAndPrefix} IN (@%s{paramName}0", [ $"@%s{paramName}0", Sql.string (string it) ])
|
||||
|> Seq.head)
|
||||
|> function sql, ps -> $"{sql})", ps
|
||||
|
||||
/// Create the SQL and parameters for match-any array query
|
||||
let arrayContains<'T> name (valueFunc: 'T -> string) (items: 'T list) =
|
||||
$"data['{name}'] ?| @{name}Values",
|
||||
($"@{name}Values", Sql.stringArray (items |> List.map valueFunc |> Array.ofList))
|
||||
Query.byContains (Query.find tableName)
|
||||
|
||||
/// Get the first result of the given query
|
||||
let tryHead<'T> (query: Task<'T list>) = backgroundTask {
|
||||
@ -162,13 +141,9 @@ module Document =
|
||||
/// Find a document by its ID for the given web log
|
||||
let findByIdAndWebLog<'TKey, 'TDoc> table (key: 'TKey) webLogId =
|
||||
Custom.single
|
||||
$"""{Query.selectFromTable table} WHERE {Query.whereById "@id"} AND {Query.whereDataContains "@criteria"}"""
|
||||
$"""{Query.find table} WHERE {Query.whereById "@id"} AND {Query.whereDataContains "@criteria"}"""
|
||||
[ "@id", Sql.string (string key); webLogContains webLogId ]
|
||||
fromData<'TDoc>
|
||||
|
||||
/// Find documents for the given web log
|
||||
let findByWebLog<'TDoc> table webLogId : Task<'TDoc list> =
|
||||
Find.byContains table (webLogDoc webLogId)
|
||||
|
||||
|
||||
/// Functions to support revisions
|
||||
@ -186,7 +161,7 @@ module Revisions =
|
||||
Custom.list
|
||||
$"""SELECT pr.*
|
||||
FROM %s{revTable} pr
|
||||
INNER JOIN %s{entityTable} p ON p.data ->> '{nameof Post.Empty.Id}' = pr.{entityTable}_id
|
||||
INNER JOIN %s{entityTable} p ON p.data->>'{nameof Post.Empty.Id}' = pr.{entityTable}_id
|
||||
WHERE p.{Query.whereDataContains "@criteria"}
|
||||
ORDER BY as_of DESC"""
|
||||
[ webLogContains webLogId ]
|
||||
|
@ -33,6 +33,10 @@ type PostgresPageData(log: ILogger) =
|
||||
log.LogTrace "Page.pageExists"
|
||||
Document.existsByWebLog Table.Page pageId webLogId
|
||||
|
||||
/// The query to get all pages ordered by title
|
||||
let sortedPages =
|
||||
selectWithCriteria Table.Page + Query.orderBy [ Field.Named $"i:{nameof Page.Empty.Title}" ] PostgreSQL
|
||||
|
||||
// IMPLEMENTATION FUNCTIONS
|
||||
|
||||
/// Add a page
|
||||
@ -47,7 +51,7 @@ type PostgresPageData(log: ILogger) =
|
||||
let all webLogId =
|
||||
log.LogTrace "Page.all"
|
||||
Custom.list
|
||||
$"{selectWithCriteria Table.Page} ORDER BY LOWER(data ->> '{nameof Page.Empty.Title}')"
|
||||
sortedPages
|
||||
[ webLogContains webLogId ]
|
||||
(fun row -> { fromData<Page> row with Text = ""; Metadata = []; PriorPermalinks = [] })
|
||||
|
||||
@ -86,8 +90,8 @@ type PostgresPageData(log: ILogger) =
|
||||
match! pageExists pageId webLogId with
|
||||
| true ->
|
||||
do! Custom.nonQuery
|
||||
$"""DELETE FROM {Table.PageRevision} WHERE page_id = @id;
|
||||
DELETE FROM {Table.Page} WHERE {Query.whereById "@id"}"""
|
||||
$"""{Query.delete Table.PageRevision} WHERE page_id = @id;
|
||||
{Query.delete Table.Page} WHERE {Query.whereById "@id"}"""
|
||||
[ idParam pageId ]
|
||||
return true
|
||||
| false -> return false
|
||||
@ -107,21 +111,19 @@ type PostgresPageData(log: ILogger) =
|
||||
log.LogTrace "Page.findCurrentPermalink"
|
||||
if List.isEmpty permalinks then return None
|
||||
else
|
||||
let linkSql, linkParam = arrayContains (nameof Page.Empty.PriorPermalinks) string permalinks
|
||||
return!
|
||||
Custom.single
|
||||
$"""SELECT data ->> '{nameof Page.Empty.Permalink}' AS permalink
|
||||
FROM page
|
||||
WHERE {Query.whereDataContains "@criteria"}
|
||||
AND {linkSql}"""
|
||||
[ webLogContains webLogId; linkParam ]
|
||||
Map.toPermalink
|
||||
let linkField = Field.InArray (nameof Page.Empty.PriorPermalinks) Table.Page (List.map string permalinks)
|
||||
let query =
|
||||
(Query.statementWhere
|
||||
(Query.find Table.Page)
|
||||
$"""{Query.whereDataContains "@criteria"} AND {Query.whereByFields All [ linkField ]}""")
|
||||
.Replace("SELECT data", $"SELECT data->>'{nameof Page.Empty.Permalink}' AS permalink")
|
||||
return! Custom.single query (addFieldParams [ linkField ] [ webLogContains webLogId ]) Map.toPermalink
|
||||
}
|
||||
|
||||
/// Get all complete pages for the given web log
|
||||
let findFullByWebLog webLogId = backgroundTask {
|
||||
log.LogTrace "Page.findFullByWebLog"
|
||||
let! pages = Document.findByWebLog<Page> Table.Page webLogId
|
||||
let! pages = Find.byContains<Page> Table.Page (webLogDoc webLogId)
|
||||
let! revisions = Revisions.findByWebLog Table.PageRevision Table.Page PageId webLogId
|
||||
return
|
||||
pages
|
||||
@ -133,17 +135,13 @@ type PostgresPageData(log: ILogger) =
|
||||
let findListed webLogId =
|
||||
log.LogTrace "Page.findListed"
|
||||
Custom.list
|
||||
$"{selectWithCriteria Table.Page} ORDER BY LOWER(data ->> '{nameof Page.Empty.Title}')"
|
||||
[ jsonParam "@criteria" {| webLogDoc webLogId with IsInPageList = true |} ]
|
||||
pageWithoutText
|
||||
sortedPages [ jsonParam "@criteria" {| webLogDoc webLogId with IsInPageList = true |} ] pageWithoutText
|
||||
|
||||
/// Get a page of pages for the given web log (without revisions)
|
||||
let findPageOfPages webLogId pageNbr =
|
||||
log.LogTrace "Page.findPageOfPages"
|
||||
Custom.list
|
||||
$"{selectWithCriteria Table.Page}
|
||||
ORDER BY LOWER(data->>'{nameof Page.Empty.Title}')
|
||||
LIMIT @pageSize OFFSET @toSkip"
|
||||
$"{sortedPages} LIMIT @pageSize OFFSET @toSkip"
|
||||
[ webLogContains webLogId; "@pageSize", Sql.int 26; "@toSkip", Sql.int ((pageNbr - 1) * 25) ]
|
||||
(fun row -> { fromData<Page> row with Metadata = []; PriorPermalinks = [] })
|
||||
|
||||
|
@ -84,9 +84,9 @@ type PostgresPostData(log: ILogger) =
|
||||
match! postExists postId webLogId with
|
||||
| true ->
|
||||
do! Custom.nonQuery
|
||||
$"""DELETE FROM {Table.PostComment} WHERE {Query.whereDataContains "@criteria"};
|
||||
DELETE FROM {Table.PostRevision} WHERE post_id = @id;
|
||||
DELETE FROM {Table.Post} WHERE {Query.whereById "@id"}"""
|
||||
$"""{Query.delete Table.PostComment} WHERE {Query.whereDataContains "@criteria"};
|
||||
{Query.delete Table.PostRevision} WHERE post_id = @id;
|
||||
{Query.delete Table.Post} WHERE {Query.whereById "@id"}"""
|
||||
[ idParam postId; jsonParam "@criteria" {| PostId = postId |} ]
|
||||
return true
|
||||
| false -> return false
|
||||
@ -97,21 +97,19 @@ type PostgresPostData(log: ILogger) =
|
||||
log.LogTrace "Post.findCurrentPermalink"
|
||||
if List.isEmpty permalinks then return None
|
||||
else
|
||||
let linkSql, linkParam = arrayContains (nameof Post.Empty.PriorPermalinks) string permalinks
|
||||
return!
|
||||
Custom.single
|
||||
$"""SELECT data ->> '{nameof Post.Empty.Permalink}' AS permalink
|
||||
FROM {Table.Post}
|
||||
WHERE {Query.whereDataContains "@criteria"}
|
||||
AND {linkSql}"""
|
||||
[ webLogContains webLogId; linkParam ]
|
||||
Map.toPermalink
|
||||
let linkField = Field.InArray (nameof Post.Empty.PriorPermalinks) Table.Post (List.map string permalinks)
|
||||
let query =
|
||||
(Query.statementWhere
|
||||
(Query.find Table.Post)
|
||||
$"""{Query.whereDataContains "@criteria"} AND {Query.whereByFields All [ linkField ]}""")
|
||||
.Replace("SELECT data", $"SELECT data->>'{nameof Post.Empty.Permalink}' AS permalink")
|
||||
return! Custom.single query (addFieldParams [ linkField ] [ webLogContains webLogId ]) Map.toPermalink
|
||||
}
|
||||
|
||||
/// Get all complete posts for the given web log
|
||||
let findFullByWebLog webLogId = backgroundTask {
|
||||
log.LogTrace "Post.findFullByWebLog"
|
||||
let! posts = Document.findByWebLog<Post> Table.Post webLogId
|
||||
let! posts = Find.byContains<Post> Table.Post (webLogDoc webLogId)
|
||||
let! revisions = Revisions.findByWebLog Table.PostRevision Table.Post PostId webLogId
|
||||
return
|
||||
posts
|
||||
@ -122,23 +120,26 @@ type PostgresPostData(log: ILogger) =
|
||||
/// Get a page of categorized posts for the given web log (excludes revisions)
|
||||
let findPageOfCategorizedPosts webLogId (categoryIds: CategoryId list) pageNbr postsPerPage =
|
||||
log.LogTrace "Post.findPageOfCategorizedPosts"
|
||||
let catSql, catParam = arrayContains (nameof Post.Empty.CategoryIds) string categoryIds
|
||||
let catIdField = Field.InArray (nameof Post.Empty.CategoryIds) Table.Post (List.map string categoryIds)
|
||||
Custom.list
|
||||
$"{selectWithCriteria Table.Post}
|
||||
AND {catSql}
|
||||
ORDER BY data ->> '{nameof Post.Empty.PublishedOn}' DESC
|
||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|
||||
[ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |}; catParam ]
|
||||
$"""{selectWithCriteria Table.Post}
|
||||
AND {Query.whereByFields All [ catIdField ]}
|
||||
{Query.orderBy [ Field.Named $"{nameof Post.Empty.PublishedOn} DESC" ] PostgreSQL}
|
||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
|
||||
(addFieldParams [ catIdField] [ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |} ])
|
||||
postWithoutLinks
|
||||
|
||||
/// Get a page of posts for the given web log (excludes text and revisions)
|
||||
let findPageOfPosts webLogId pageNbr postsPerPage =
|
||||
log.LogTrace "Post.findPageOfPosts"
|
||||
let order =
|
||||
Query.orderBy
|
||||
[ Field.Named $"{nameof Post.Empty.PublishedOn} DESC NULLS FIRST"
|
||||
Field.Named (nameof Post.Empty.UpdatedOn) ]
|
||||
PostgreSQL
|
||||
Custom.list
|
||||
$"{selectWithCriteria Table.Post}
|
||||
ORDER BY data ->> '{nameof Post.Empty.PublishedOn}' DESC NULLS FIRST,
|
||||
data ->> '{nameof Post.Empty.UpdatedOn}'
|
||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|
||||
$"{selectWithCriteria Table.Post}{order}
|
||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|
||||
[ webLogContains webLogId ]
|
||||
postWithoutText
|
||||
|
||||
@ -146,9 +147,9 @@ type PostgresPostData(log: ILogger) =
|
||||
let findPageOfPublishedPosts webLogId pageNbr postsPerPage =
|
||||
log.LogTrace "Post.findPageOfPublishedPosts"
|
||||
Custom.list
|
||||
$"{selectWithCriteria Table.Post}
|
||||
ORDER BY data ->> '{nameof Post.Empty.PublishedOn}' DESC
|
||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|
||||
$"""{selectWithCriteria Table.Post}
|
||||
{Query.orderBy [ Field.Named $"{nameof Post.Empty.PublishedOn} DESC" ] PostgreSQL}
|
||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
|
||||
[ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |} ]
|
||||
postWithoutLinks
|
||||
|
||||
@ -156,10 +157,10 @@ type PostgresPostData(log: ILogger) =
|
||||
let findPageOfTaggedPosts webLogId (tag: string) pageNbr postsPerPage =
|
||||
log.LogTrace "Post.findPageOfTaggedPosts"
|
||||
Custom.list
|
||||
$"{selectWithCriteria Table.Post}
|
||||
AND data['{nameof Post.Empty.Tags}'] @> @tag
|
||||
ORDER BY data ->> '{nameof Post.Empty.PublishedOn}' DESC
|
||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|
||||
$"""{selectWithCriteria Table.Post}
|
||||
AND data['{nameof Post.Empty.Tags}'] @> @tag
|
||||
{Query.orderBy [ Field.Named $"{nameof Post.Empty.PublishedOn} DESC" ] PostgreSQL}
|
||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
|
||||
[ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |}; jsonParam "@tag" [| tag |] ]
|
||||
postWithoutLinks
|
||||
|
||||
@ -170,10 +171,10 @@ type PostgresPostData(log: ILogger) =
|
||||
[ jsonParam "@criteria" {| webLogDoc webLogId with Status = Published |}
|
||||
"@publishedOn", Sql.timestamptz (publishedOn.ToDateTimeOffset()) ]
|
||||
let query op direction =
|
||||
$"{selectWithCriteria Table.Post}
|
||||
AND (data ->> '{nameof Post.Empty.PublishedOn}')::timestamp with time zone %s{op} @publishedOn
|
||||
ORDER BY data ->> '{nameof Post.Empty.PublishedOn}' %s{direction}
|
||||
LIMIT 1"
|
||||
$"""{selectWithCriteria Table.Post}
|
||||
AND (data->>'{nameof Post.Empty.PublishedOn}')::timestamp with time zone %s{op} @publishedOn
|
||||
{Query.orderBy [ Field.Named $"{nameof Post.Empty.PublishedOn} %s{direction}" ] PostgreSQL}
|
||||
LIMIT 1"""
|
||||
let! older = Custom.list (query "<" "DESC") (queryParams ()) postWithoutLinks
|
||||
let! newer = Custom.list (query ">" "") (queryParams ()) postWithoutLinks
|
||||
return List.tryHead older, List.tryHead newer
|
||||
|
@ -33,18 +33,15 @@ type PostgresTagMapData(log: ILogger) =
|
||||
/// Get all tag mappings for the given web log
|
||||
let findByWebLog webLogId =
|
||||
log.LogTrace "TagMap.findByWebLog"
|
||||
Custom.list
|
||||
$"{selectWithCriteria Table.TagMap} ORDER BY data ->> 'tag'"
|
||||
[ webLogContains webLogId ]
|
||||
fromData<TagMap>
|
||||
Find.byContainsOrdered<TagMap> Table.TagMap (webLogDoc webLogId) [ Field.Named (nameof TagMap.Empty.Tag) ]
|
||||
|
||||
/// Find any tag mappings in a list of tags for the given web log
|
||||
let findMappingForTags tags webLogId =
|
||||
let findMappingForTags (tags: string list) webLogId =
|
||||
log.LogTrace "TagMap.findMappingForTags"
|
||||
let tagSql, tagParam = arrayContains (nameof TagMap.Empty.Tag) id tags
|
||||
let tagField = Field.InArray (nameof TagMap.Empty.Tag) Table.TagMap tags
|
||||
Custom.list
|
||||
$"{selectWithCriteria Table.TagMap} AND {tagSql}"
|
||||
[ webLogContains webLogId; tagParam ]
|
||||
$"{selectWithCriteria Table.TagMap} AND {Query.whereByFields All [ tagField ]}"
|
||||
(addFieldParams [ tagField ] [ webLogContains webLogId ])
|
||||
fromData<TagMap>
|
||||
|
||||
/// Save a tag mapping
|
||||
|
@ -17,11 +17,11 @@ type PostgresThemeData(log: ILogger) =
|
||||
/// Retrieve all themes (except 'admin'; excludes template text)
|
||||
let all () =
|
||||
log.LogTrace "Theme.all"
|
||||
let fields = [ Field.NotEqual (nameof Theme.Empty.Id) "admin" ]
|
||||
Custom.list
|
||||
$"{Query.selectFromTable Table.Theme}
|
||||
WHERE data ->> '{nameof Theme.Empty.Id}' <> 'admin'
|
||||
ORDER BY data ->> '{nameof Theme.Empty.Id}'"
|
||||
[]
|
||||
(Query.byFields (Query.find Table.Theme) Any fields
|
||||
+ Query.orderBy [ Field.Named (nameof Theme.Empty.Id) ] PostgreSQL)
|
||||
(addFieldParams fields [])
|
||||
withoutTemplateText
|
||||
|
||||
/// Does a given theme exist?
|
||||
@ -37,7 +37,7 @@ type PostgresThemeData(log: ILogger) =
|
||||
/// Find a theme by its ID (excludes the text of templates)
|
||||
let findByIdWithoutText (themeId: ThemeId) =
|
||||
log.LogTrace "Theme.findByIdWithoutText"
|
||||
Custom.single (Query.Find.byId Table.Theme) [ idParam themeId ] withoutTemplateText
|
||||
Custom.single (Query.byId (Query.find Table.Theme) (string themeId)) [ idParam themeId ] withoutTemplateText
|
||||
|
||||
/// Delete a theme by its ID
|
||||
let delete themeId = backgroundTask {
|
||||
@ -45,8 +45,8 @@ type PostgresThemeData(log: ILogger) =
|
||||
match! exists themeId with
|
||||
| true ->
|
||||
do! Custom.nonQuery
|
||||
$"""DELETE FROM {Table.ThemeAsset} WHERE theme_id = @id;
|
||||
DELETE FROM {Table.Theme} WHERE {Query.whereById "@id"}"""
|
||||
$"""{Query.delete Table.ThemeAsset} WHERE theme_id = @id;
|
||||
{Query.delete Table.Theme} WHERE {Query.whereById "@id"}"""
|
||||
[ idParam themeId ]
|
||||
return true
|
||||
| false -> return false
|
||||
@ -77,7 +77,7 @@ type PostgresThemeAssetData(log: ILogger) =
|
||||
/// Delete all assets for the given theme
|
||||
let deleteByTheme (themeId: ThemeId) =
|
||||
log.LogTrace "ThemeAsset.deleteByTheme"
|
||||
Custom.nonQuery $"DELETE FROM {Table.ThemeAsset} WHERE theme_id = @id" [ idParam themeId ]
|
||||
Custom.nonQuery $"{Query.delete Table.ThemeAsset} WHERE theme_id = @id" [ idParam themeId ]
|
||||
|
||||
/// Find a theme asset by its ID
|
||||
let findById assetId =
|
||||
|
@ -23,22 +23,22 @@ type PostgresWebLogData(log: ILogger) =
|
||||
let delete webLogId =
|
||||
log.LogTrace "WebLog.delete"
|
||||
Custom.nonQuery
|
||||
$"""DELETE FROM {Table.PostComment}
|
||||
WHERE data ->> '{nameof Comment.Empty.PostId}'
|
||||
IN (SELECT data ->> '{nameof Post.Empty.Id}'
|
||||
FROM {Table.Post}
|
||||
WHERE {Query.whereDataContains "@criteria"});
|
||||
DELETE FROM {Table.PostRevision}
|
||||
WHERE post_id IN (SELECT data ->> 'Id' FROM {Table.Post} WHERE {Query.whereDataContains "@criteria"});
|
||||
DELETE FROM {Table.PageRevision}
|
||||
WHERE page_id IN (SELECT data ->> 'Id' FROM {Table.Page} WHERE {Query.whereDataContains "@criteria"});
|
||||
{Query.Delete.byContains Table.Post};
|
||||
{Query.Delete.byContains Table.Page};
|
||||
{Query.Delete.byContains Table.Category};
|
||||
{Query.Delete.byContains Table.TagMap};
|
||||
{Query.Delete.byContains Table.WebLogUser};
|
||||
DELETE FROM {Table.Upload} WHERE web_log_id = @webLogId;
|
||||
DELETE FROM {Table.WebLog} WHERE {Query.whereById "@webLogId"}"""
|
||||
$"""{Query.delete Table.PostComment}
|
||||
WHERE data->>'{nameof Comment.Empty.PostId}'
|
||||
IN (SELECT data->>'{nameof Post.Empty.Id}'
|
||||
FROM {Table.Post}
|
||||
WHERE {Query.whereDataContains "@criteria"});
|
||||
{Query.delete Table.PostRevision}
|
||||
WHERE post_id IN (SELECT data->>'Id' FROM {Table.Post} WHERE {Query.whereDataContains "@criteria"});
|
||||
{Query.delete Table.PageRevision}
|
||||
WHERE page_id IN (SELECT data->>'Id' FROM {Table.Page} WHERE {Query.whereDataContains "@criteria"});
|
||||
{Query.byContains (Query.delete Table.Post)};
|
||||
{Query.byContains (Query.delete Table.Page)};
|
||||
{Query.byContains (Query.delete Table.Category)};
|
||||
{Query.byContains (Query.delete Table.TagMap)};
|
||||
{Query.byContains (Query.delete Table.WebLogUser)};
|
||||
{Query.delete Table.Upload} WHERE web_log_id = @webLogId;
|
||||
{Query.delete Table.WebLog} WHERE data->>'Id' = @webLogId"""
|
||||
[ webLogIdParam webLogId; webLogContains webLogId ]
|
||||
|
||||
/// Find a web log by its host (URL base)
|
||||
|
@ -49,19 +49,17 @@ type PostgresWebLogUserData(log: ILogger) =
|
||||
/// Get all users for the given web log
|
||||
let findByWebLog webLogId =
|
||||
log.LogTrace "WebLogUser.findByWebLog"
|
||||
Custom.list
|
||||
$"{selectWithCriteria Table.WebLogUser} ORDER BY LOWER(data ->> '{nameof WebLogUser.Empty.PreferredName}')"
|
||||
[ webLogContains webLogId ]
|
||||
fromData<WebLogUser>
|
||||
Find.byContainsOrdered<WebLogUser>
|
||||
Table.WebLogUser (webLogDoc webLogId) [ Field.Named $"i:{nameof WebLogUser.Empty.PreferredName}" ]
|
||||
|
||||
/// Find the names of users by their IDs for the given web log
|
||||
let findNames webLogId (userIds: WebLogUserId list) = backgroundTask {
|
||||
log.LogTrace "WebLogUser.findNames"
|
||||
let idSql, idParams = inClause $"AND data ->> '{nameof WebLogUser.Empty.Id}'" "id" userIds
|
||||
let idField = Field.In (nameof WebLogUser.Empty.Id) (List.map string userIds)
|
||||
let! users =
|
||||
Custom.list
|
||||
$"{selectWithCriteria Table.WebLogUser} {idSql}"
|
||||
(webLogContains webLogId :: idParams)
|
||||
$"{selectWithCriteria Table.WebLogUser} AND {Query.whereByFields All [ idField ]}"
|
||||
(addFieldParams [ idField ] [ webLogContains webLogId ])
|
||||
fromData<WebLogUser>
|
||||
return users |> List.map (fun u -> { Name = string u.Id; Value = u.DisplayName })
|
||||
}
|
||||
|
@ -25,7 +25,7 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
|
||||
// Theme tables
|
||||
if needsTable Table.Theme then
|
||||
Query.Definition.ensureTable Table.Theme
|
||||
Query.Definition.ensureKey Table.Theme
|
||||
Query.Definition.ensureKey Table.Theme PostgreSQL
|
||||
if needsTable Table.ThemeAsset then
|
||||
$"CREATE TABLE {Table.ThemeAsset} (
|
||||
theme_id TEXT NOT NULL,
|
||||
@ -37,28 +37,28 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
|
||||
// Web log table
|
||||
if needsTable Table.WebLog then
|
||||
Query.Definition.ensureTable Table.WebLog
|
||||
Query.Definition.ensureKey Table.WebLog
|
||||
Query.Definition.ensureKey Table.WebLog PostgreSQL
|
||||
Query.Definition.ensureDocumentIndex Table.WebLog Optimized
|
||||
|
||||
// Category table
|
||||
if needsTable Table.Category then
|
||||
Query.Definition.ensureTable Table.Category
|
||||
Query.Definition.ensureKey Table.Category
|
||||
Query.Definition.ensureKey Table.Category PostgreSQL
|
||||
Query.Definition.ensureDocumentIndex Table.Category Optimized
|
||||
|
||||
// Web log user table
|
||||
if needsTable Table.WebLogUser then
|
||||
Query.Definition.ensureTable Table.WebLogUser
|
||||
Query.Definition.ensureKey Table.WebLogUser
|
||||
Query.Definition.ensureKey Table.WebLogUser PostgreSQL
|
||||
Query.Definition.ensureDocumentIndex Table.WebLogUser Optimized
|
||||
|
||||
// Page tables
|
||||
if needsTable Table.Page then
|
||||
Query.Definition.ensureTable Table.Page
|
||||
Query.Definition.ensureKey Table.Page
|
||||
Query.Definition.ensureIndexOn Table.Page "author" [ nameof Page.Empty.AuthorId ]
|
||||
Query.Definition.ensureKey Table.Page PostgreSQL
|
||||
Query.Definition.ensureIndexOn Table.Page "author" [ nameof Page.Empty.AuthorId ] PostgreSQL
|
||||
Query.Definition.ensureIndexOn
|
||||
Table.Page "permalink" [ nameof Page.Empty.WebLogId; nameof Page.Empty.Permalink ]
|
||||
Table.Page "permalink" [ nameof Page.Empty.WebLogId; nameof Page.Empty.Permalink ] PostgreSQL
|
||||
if needsTable Table.PageRevision then
|
||||
$"CREATE TABLE {Table.PageRevision} (
|
||||
page_id TEXT NOT NULL,
|
||||
@ -69,14 +69,15 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
|
||||
// Post tables
|
||||
if needsTable Table.Post then
|
||||
Query.Definition.ensureTable Table.Post
|
||||
Query.Definition.ensureKey Table.Post
|
||||
Query.Definition.ensureIndexOn Table.Post "author" [ nameof Post.Empty.AuthorId ]
|
||||
Query.Definition.ensureKey Table.Post PostgreSQL
|
||||
Query.Definition.ensureIndexOn Table.Post "author" [ nameof Post.Empty.AuthorId ] PostgreSQL
|
||||
Query.Definition.ensureIndexOn
|
||||
Table.Post "permalink" [ nameof Post.Empty.WebLogId; nameof Post.Empty.Permalink ]
|
||||
Table.Post "permalink" [ nameof Post.Empty.WebLogId; nameof Post.Empty.Permalink ] PostgreSQL
|
||||
Query.Definition.ensureIndexOn
|
||||
Table.Post
|
||||
"status"
|
||||
[ nameof Post.Empty.WebLogId; nameof Post.Empty.Status; nameof Post.Empty.UpdatedOn ]
|
||||
PostgreSQL
|
||||
$"CREATE INDEX idx_post_category ON {Table.Post} USING GIN ((data['{nameof Post.Empty.CategoryIds}']))"
|
||||
$"CREATE INDEX idx_post_tag ON {Table.Post} USING GIN ((data['{nameof Post.Empty.Tags}']))"
|
||||
if needsTable Table.PostRevision then
|
||||
@ -87,13 +88,13 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
|
||||
PRIMARY KEY (post_id, as_of))"
|
||||
if needsTable Table.PostComment then
|
||||
Query.Definition.ensureTable Table.PostComment
|
||||
Query.Definition.ensureKey Table.PostComment
|
||||
Query.Definition.ensureIndexOn Table.PostComment "post" [ nameof Comment.Empty.PostId ]
|
||||
Query.Definition.ensureKey Table.PostComment PostgreSQL
|
||||
Query.Definition.ensureIndexOn Table.PostComment "post" [ nameof Comment.Empty.PostId ] PostgreSQL
|
||||
|
||||
// Tag map table
|
||||
if needsTable Table.TagMap then
|
||||
Query.Definition.ensureTable Table.TagMap
|
||||
Query.Definition.ensureKey Table.TagMap
|
||||
Query.Definition.ensureKey Table.TagMap PostgreSQL
|
||||
Query.Definition.ensureDocumentIndex Table.TagMap Optimized
|
||||
|
||||
// Uploaded file table
|
||||
@ -153,7 +154,8 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
|
||||
Table.WebLogUser ]
|
||||
|
||||
Utils.Migration.logStep log migration "Adding unique indexes on ID fields"
|
||||
do! Custom.nonQuery (tables |> List.map Query.Definition.ensureKey |> String.concat "; ") []
|
||||
do! Custom.nonQuery
|
||||
(tables |> List.map (fun it -> Query.Definition.ensureKey it PostgreSQL) |> String.concat "; ") []
|
||||
|
||||
Utils.Migration.logStep log migration "Removing constraints"
|
||||
let fkToDrop =
|
||||
@ -187,24 +189,25 @@ type PostgresData(log: ILogger<PostgresData>, ser: JsonSerializer) =
|
||||
|
||||
Utils.Migration.logStep log migration "Adding new indexes"
|
||||
let newIdx =
|
||||
[ yield! tables |> List.map Query.Definition.ensureKey
|
||||
[ yield! tables |> List.map (fun it -> Query.Definition.ensureKey it PostgreSQL)
|
||||
Query.Definition.ensureDocumentIndex Table.Category Optimized
|
||||
Query.Definition.ensureDocumentIndex Table.TagMap Optimized
|
||||
Query.Definition.ensureDocumentIndex Table.WebLog Optimized
|
||||
Query.Definition.ensureDocumentIndex Table.WebLogUser Optimized
|
||||
Query.Definition.ensureIndexOn Table.Page "author" [ nameof Page.Empty.AuthorId ]
|
||||
Query.Definition.ensureIndexOn Table.Page "author" [ nameof Page.Empty.AuthorId ] PostgreSQL
|
||||
Query.Definition.ensureIndexOn
|
||||
Table.Page "permalink" [ nameof Page.Empty.WebLogId; nameof Page.Empty.Permalink ]
|
||||
Query.Definition.ensureIndexOn Table.Post "author" [ nameof Post.Empty.AuthorId ]
|
||||
Table.Page "permalink" [ nameof Page.Empty.WebLogId; nameof Page.Empty.Permalink ] PostgreSQL
|
||||
Query.Definition.ensureIndexOn Table.Post "author" [ nameof Post.Empty.AuthorId ] PostgreSQL
|
||||
Query.Definition.ensureIndexOn
|
||||
Table.Post "permalink" [ nameof Post.Empty.WebLogId; nameof Post.Empty.Permalink ]
|
||||
Table.Post "permalink" [ nameof Post.Empty.WebLogId; nameof Post.Empty.Permalink ] PostgreSQL
|
||||
Query.Definition.ensureIndexOn
|
||||
Table.Post
|
||||
"status"
|
||||
[ nameof Post.Empty.WebLogId; nameof Post.Empty.Status; nameof Post.Empty.UpdatedOn ]
|
||||
PostgreSQL
|
||||
$"CREATE INDEX idx_post_category ON {Table.Post} USING GIN ((data['{nameof Post.Empty.CategoryIds}']))"
|
||||
$"CREATE INDEX idx_post_tag ON {Table.Post} USING GIN ((data['{nameof Post.Empty.Tags}']))"
|
||||
Query.Definition.ensureIndexOn Table.PostComment "post" [ nameof Comment.Empty.PostId ] ]
|
||||
Query.Definition.ensureIndexOn Table.PostComment "post" [ nameof Comment.Empty.PostId ] PostgreSQL ]
|
||||
do! Custom.nonQuery (newIdx |> String.concat "; ") []
|
||||
|
||||
Utils.Migration.logStep log migration "Setting database to version 2.1.1"
|
||||
|
@ -16,22 +16,23 @@ type SQLiteCategoryData(conn: SqliteConnection, ser: JsonSerializer, log: ILogge
|
||||
let parentIdField = nameof Category.Empty.ParentId
|
||||
|
||||
/// Count all categories for the given web log
|
||||
let countAll webLogId =
|
||||
let countAll webLogId = backgroundTask {
|
||||
log.LogTrace "Category.countAll"
|
||||
Document.countByWebLog Table.Category webLogId conn
|
||||
let! count = conn.countByFields Table.Category Any [ webLogField webLogId ]
|
||||
return int count
|
||||
}
|
||||
|
||||
/// Count all top-level categories for the given web log
|
||||
let countTopLevel webLogId =
|
||||
let countTopLevel webLogId = backgroundTask {
|
||||
log.LogTrace "Category.countTopLevel"
|
||||
conn.customScalar
|
||||
$"{Document.Query.countByWebLog Table.Category} AND data ->> '{parentIdField}' IS NULL"
|
||||
[ webLogParam webLogId ]
|
||||
(toCount >> int)
|
||||
let! count = conn.countByFields Table.Category All [ webLogField webLogId; Field.NotExists parentIdField ]
|
||||
return int count
|
||||
}
|
||||
|
||||
/// Find all categories for the given web log
|
||||
let findByWebLog webLogId =
|
||||
log.LogTrace "Category.findByWebLog"
|
||||
Document.findByWebLog<Category> Table.Category webLogId conn
|
||||
conn.findByFields<Category> Table.Category Any [ webLogField webLogId ]
|
||||
|
||||
/// Retrieve all categories for the given web log in a DotLiquid-friendly format
|
||||
let findAllForView webLogId = backgroundTask {
|
||||
@ -42,20 +43,18 @@ type SQLiteCategoryData(conn: SqliteConnection, ser: JsonSerializer, log: ILogge
|
||||
ordered
|
||||
|> Seq.map (fun it -> backgroundTask {
|
||||
// Parent category post counts include posts in subcategories
|
||||
let catSql, catParams =
|
||||
let childField =
|
||||
ordered
|
||||
|> Seq.filter (fun cat -> cat.ParentNames |> Array.contains it.Name)
|
||||
|> Seq.map _.Id
|
||||
|> Seq.append (Seq.singleton it.Id)
|
||||
|> List.ofSeq
|
||||
|> inJsonArray Table.Post (nameof Post.Empty.CategoryIds) "catId"
|
||||
let query = $"""
|
||||
SELECT COUNT(DISTINCT data ->> '{nameof Post.Empty.Id}')
|
||||
FROM {Table.Post}
|
||||
WHERE {Document.Query.whereByWebLog}
|
||||
AND {Query.whereByField (Field.EQ (nameof Post.Empty.Status) "") $"'{string Published}'"}
|
||||
AND {catSql}"""
|
||||
let! postCount = conn.customScalar query (webLogParam webLogId :: catParams) toCount
|
||||
|> Field.InArray (nameof Post.Empty.CategoryIds) Table.Post
|
||||
let fields =
|
||||
[ webLogField webLogId; Field.Equal (nameof Post.Empty.Status) (string Published); childField ]
|
||||
let query =
|
||||
(Query.statementWhere (Query.count Table.Post) (Query.whereByFields All fields))
|
||||
.Replace("(*)", $"(DISTINCT data->>'{nameof Post.Empty.Id}')")
|
||||
let! postCount = conn.customScalar query (addFieldParams fields []) toCount
|
||||
return it.Id, int postCount
|
||||
})
|
||||
|> Task.WhenAll
|
||||
@ -69,9 +68,9 @@ type SQLiteCategoryData(conn: SqliteConnection, ser: JsonSerializer, log: ILogge
|
||||
}
|
||||
|
||||
/// Find a category by its ID for the given web log
|
||||
let findById catId webLogId =
|
||||
let findById (catId: CategoryId) webLogId =
|
||||
log.LogTrace "Category.findById"
|
||||
Document.findByIdAndWebLog<CategoryId, Category> Table.Category catId webLogId conn
|
||||
conn.findFirstByFields<Category> Table.Category All [ idField catId; webLogField webLogId ]
|
||||
|
||||
/// Delete a category
|
||||
let delete catId webLogId = backgroundTask {
|
||||
@ -79,24 +78,22 @@ type SQLiteCategoryData(conn: SqliteConnection, ser: JsonSerializer, log: ILogge
|
||||
match! findById catId webLogId with
|
||||
| Some cat ->
|
||||
// Reassign any children to the category's parent category
|
||||
let! children = conn.countByField Table.Category (Field.EQ parentIdField (string catId))
|
||||
let! children = conn.countByFields Table.Category Any [ Field.Equal parentIdField (string catId) ]
|
||||
if children > 0L then
|
||||
let parent = Field.EQ parentIdField (string catId)
|
||||
let parent = [ Field.Equal parentIdField (string catId) ]
|
||||
match cat.ParentId with
|
||||
| Some _ -> do! conn.patchByField Table.Category parent {| ParentId = cat.ParentId |}
|
||||
| None -> do! conn.removeFieldsByField Table.Category parent [ parentIdField ]
|
||||
| Some _ -> do! conn.patchByFields Table.Category Any parent {| ParentId = cat.ParentId |}
|
||||
| None -> do! conn.removeFieldsByFields Table.Category Any parent [ parentIdField ]
|
||||
// Delete the category off all posts where it is assigned, and the category itself
|
||||
let catIdField = nameof Post.Empty.CategoryIds
|
||||
let fields = [ webLogField webLogId; Field.InArray catIdField Table.Post [ string catId ] ]
|
||||
let query =
|
||||
(Query.statementWhere (Query.find Table.Post) (Query.whereByFields All fields))
|
||||
.Replace("SELECT data", $"SELECT data->>'{nameof Post.Empty.Id}', data->'{catIdField}'")
|
||||
let! posts =
|
||||
conn.customList
|
||||
$"SELECT data ->> '{nameof Post.Empty.Id}', data -> '{catIdField}'
|
||||
FROM {Table.Post}
|
||||
WHERE {Document.Query.whereByWebLog}
|
||||
AND EXISTS
|
||||
(SELECT 1
|
||||
FROM json_each({Table.Post}.data -> '{catIdField}')
|
||||
WHERE json_each.value = @id)"
|
||||
[ idParam catId; webLogParam webLogId ]
|
||||
query
|
||||
(addFieldParams fields [])
|
||||
(fun rdr -> rdr.GetString 0, Utils.deserialize<string list> ser (rdr.GetString 1))
|
||||
for postId, cats in posts do
|
||||
do! conn.patchById
|
||||
|
@ -82,39 +82,6 @@ let instantParam =
|
||||
let maybeInstant =
|
||||
Option.map instantParam >> maybe
|
||||
|
||||
/// Create the SQL and parameters for an EXISTS applied to a JSON array
|
||||
let inJsonArray<'T> table jsonField paramName (items: 'T list) =
|
||||
if List.isEmpty items then "", []
|
||||
else
|
||||
let mutable idx = 0
|
||||
items
|
||||
|> List.skip 1
|
||||
|> List.fold (fun (itemS, itemP) it ->
|
||||
idx <- idx + 1
|
||||
$"{itemS}, @%s{paramName}{idx}", (SqliteParameter($"@%s{paramName}{idx}", string it) :: itemP))
|
||||
(Seq.ofList items
|
||||
|> Seq.map (fun it -> $"(@%s{paramName}0", [ SqliteParameter($"@%s{paramName}0", string it) ])
|
||||
|> Seq.head)
|
||||
|> function
|
||||
sql, ps ->
|
||||
$"EXISTS (SELECT 1 FROM json_each(%s{table}.data, '$.%s{jsonField}') WHERE value IN {sql}))", ps
|
||||
|
||||
/// Create the SQL and parameters for an IN clause
|
||||
let inClause<'T> colNameAndPrefix paramName (valueFunc: 'T -> string) (items: 'T list) =
|
||||
if List.isEmpty items then "", []
|
||||
else
|
||||
let mutable idx = 0
|
||||
items
|
||||
|> List.skip 1
|
||||
|> List.fold (fun (itemS, itemP) it ->
|
||||
idx <- idx + 1
|
||||
$"{itemS}, @%s{paramName}{idx}", (SqliteParameter ($"@%s{paramName}{idx}", valueFunc it) :: itemP))
|
||||
(Seq.ofList items
|
||||
|> Seq.map (fun it ->
|
||||
$"%s{colNameAndPrefix} IN (@%s{paramName}0", [ SqliteParameter ($"@%s{paramName}0", valueFunc it) ])
|
||||
|> Seq.head)
|
||||
|> function sql, ps -> $"{sql})", ps
|
||||
|
||||
|
||||
/// Functions to map domain items from a data reader
|
||||
module Map =
|
||||
@ -218,6 +185,8 @@ module Map =
|
||||
Data = data }
|
||||
|
||||
|
||||
open BitBadger.Documents
|
||||
|
||||
/// Create a named parameter
|
||||
let sqlParam name (value: obj) =
|
||||
SqliteParameter(name, value)
|
||||
@ -226,48 +195,18 @@ let sqlParam name (value: obj) =
|
||||
let webLogParam (webLogId: WebLogId) =
|
||||
sqlParam "@webLogId" (string webLogId)
|
||||
|
||||
/// Create a field for an ID value
|
||||
let idField<'T> (idValue: 'T) =
|
||||
{ Field.Equal "Id" (string idValue) with ParameterName = Some "@id" }
|
||||
|
||||
/// Create a web log field
|
||||
let webLogField (webLogId: WebLogId) =
|
||||
{ Field.Equal "WebLogId" (string webLogId) with ParameterName = Some "@webLogId" }
|
||||
|
||||
|
||||
open BitBadger.Documents
|
||||
open BitBadger.Documents.Sqlite
|
||||
open BitBadger.Documents.Sqlite.WithConn
|
||||
|
||||
/// Functions for manipulating documents
|
||||
module Document =
|
||||
|
||||
/// Queries to assist with document manipulation
|
||||
module Query =
|
||||
|
||||
/// Fragment to add a web log ID condition to a WHERE clause (parameter @webLogId)
|
||||
let whereByWebLog =
|
||||
Query.whereByField (Field.EQ "WebLogId" "") "@webLogId"
|
||||
|
||||
/// A SELECT query to count documents for a given web log ID
|
||||
let countByWebLog table =
|
||||
$"{Query.Count.all table} WHERE {whereByWebLog}"
|
||||
|
||||
/// A query to select from a table by the document's ID and its web log ID
|
||||
let selectByIdAndWebLog table =
|
||||
$"{Query.Find.byId table} AND {whereByWebLog}"
|
||||
|
||||
/// A query to select from a table by its web log ID
|
||||
let selectByWebLog table =
|
||||
$"{Query.selectFromTable table} WHERE {whereByWebLog}"
|
||||
|
||||
/// Count documents for the given web log ID
|
||||
let countByWebLog table (webLogId: WebLogId) conn = backgroundTask {
|
||||
let! count = Count.byField table (Field.EQ "WebLogId" (string webLogId)) conn
|
||||
return int count
|
||||
}
|
||||
|
||||
/// Find a document by its ID and web log ID
|
||||
let findByIdAndWebLog<'TKey, 'TDoc> table (key: 'TKey) webLogId conn =
|
||||
Custom.single (Query.selectByIdAndWebLog table) [ idParam key; webLogParam webLogId ] fromData<'TDoc> conn
|
||||
|
||||
/// Find documents for the given web log
|
||||
let findByWebLog<'TDoc> table (webLogId: WebLogId) conn =
|
||||
Find.byField<'TDoc> table (Field.EQ "WebLogId" (string webLogId)) conn
|
||||
|
||||
|
||||
/// Functions to support revisions
|
||||
module Revisions =
|
||||
|
||||
@ -284,8 +223,8 @@ module Revisions =
|
||||
Custom.list
|
||||
$"SELECT pr.*
|
||||
FROM %s{revTable} pr
|
||||
INNER JOIN %s{entityTable} p ON p.data ->> 'Id' = pr.{entityTable}_id
|
||||
WHERE p.{Document.Query.whereByWebLog}
|
||||
INNER JOIN %s{entityTable} p ON p.data->>'Id' = pr.{entityTable}_id
|
||||
WHERE p.{Query.whereByFields Any [ webLogField webLogId ]}
|
||||
ORDER BY as_of DESC"
|
||||
[ webLogParam webLogId ]
|
||||
(fun rdr -> keyFunc (Map.getString $"{entityTable}_id" rdr), Map.toRevision rdr)
|
||||
|
@ -17,8 +17,10 @@ type SQLitePageData(conn: SqliteConnection, log: ILogger) =
|
||||
/// The JSON field name for the "is in page list" flag
|
||||
let pgListName = nameof Page.Empty.IsInPageList
|
||||
|
||||
/// The JSON field for the title of the page
|
||||
let titleField = $"data ->> '{nameof Page.Empty.Title}'"
|
||||
/// Query to return pages sorted by title
|
||||
let sortedPages fields =
|
||||
Query.byFields (Query.find Table.Page) All fields
|
||||
+ Query.orderBy [ Field.Named $"i:{nameof Page.Empty.Title}" ] SQLite
|
||||
|
||||
// SUPPORT FUNCTIONS
|
||||
|
||||
@ -50,36 +52,38 @@ type SQLitePageData(conn: SqliteConnection, log: ILogger) =
|
||||
/// Get all pages for a web log (without text, metadata, revisions, or prior permalinks)
|
||||
let all webLogId =
|
||||
log.LogTrace "Page.all"
|
||||
let field = [ webLogField webLogId ]
|
||||
conn.customList
|
||||
$"{Query.selectFromTable Table.Page} WHERE {Document.Query.whereByWebLog} ORDER BY LOWER({titleField})"
|
||||
[ webLogParam webLogId ]
|
||||
(sortedPages field)
|
||||
(addFieldParams field [])
|
||||
(fun rdr -> { fromData<Page> rdr with Text = ""; Metadata = []; PriorPermalinks = [] })
|
||||
|
||||
/// Count all pages for the given web log
|
||||
let countAll webLogId =
|
||||
let countAll webLogId = backgroundTask {
|
||||
log.LogTrace "Page.countAll"
|
||||
Document.countByWebLog Table.Page webLogId conn
|
||||
let! count = conn.countByFields Table.Page Any [ webLogField webLogId ]
|
||||
return int count
|
||||
}
|
||||
|
||||
/// Count all pages shown in the page list for the given web log
|
||||
let countListed webLogId =
|
||||
let countListed webLogId = backgroundTask {
|
||||
log.LogTrace "Page.countListed"
|
||||
conn.customScalar
|
||||
$"""{Document.Query.countByWebLog Table.Page} AND {Query.whereByField (Field.EQ pgListName "") "true"}"""
|
||||
[ webLogParam webLogId ]
|
||||
(toCount >> int)
|
||||
let! count = conn.countByFields Table.Page All [ webLogField webLogId; Field.Equal pgListName true ]
|
||||
return int count
|
||||
}
|
||||
|
||||
/// Find a page by its ID (without revisions and prior permalinks)
|
||||
let findById pageId webLogId = backgroundTask {
|
||||
let findById (pageId: PageId) webLogId = backgroundTask {
|
||||
log.LogTrace "Page.findById"
|
||||
match! Document.findByIdAndWebLog<PageId, Page> Table.Page pageId webLogId conn with
|
||||
match! conn.findFirstByFields<Page> Table.Page All [ idField pageId; webLogField webLogId ] with
|
||||
| Some page -> return Some { page with PriorPermalinks = [] }
|
||||
| None -> return None
|
||||
}
|
||||
|
||||
/// Find a complete page by its ID
|
||||
let findFullById pageId webLogId = backgroundTask {
|
||||
let findFullById (pageId: PageId) webLogId = backgroundTask {
|
||||
log.LogTrace "Page.findFullById"
|
||||
match! Document.findByIdAndWebLog<PageId, Page> Table.Page pageId webLogId conn with
|
||||
match! conn.findFirstByFields<Page> Table.Page All [ idField pageId; webLogField webLogId ] with
|
||||
| Some page ->
|
||||
let! page = appendPageRevisions page
|
||||
return Some page
|
||||
@ -93,7 +97,8 @@ type SQLitePageData(conn: SqliteConnection, log: ILogger) =
|
||||
match! findById pageId webLogId with
|
||||
| Some _ ->
|
||||
do! conn.customNonQuery
|
||||
$"DELETE FROM {Table.PageRevision} WHERE page_id = @id; {Query.Delete.byId Table.Page}"
|
||||
$"{Query.delete Table.PageRevision} WHERE page_id = @id;
|
||||
{Query.byId (Query.delete Table.Page) (string pageId)}"
|
||||
[ idParam pageId ]
|
||||
return true
|
||||
| None -> return false
|
||||
@ -102,27 +107,25 @@ type SQLitePageData(conn: SqliteConnection, log: ILogger) =
|
||||
/// Find a page by its permalink for the given web log
|
||||
let findByPermalink (permalink: Permalink) webLogId =
|
||||
log.LogTrace "Page.findByPermalink"
|
||||
let linkParam = Field.EQ linkName (string permalink)
|
||||
let fields = [ webLogField webLogId; Field.Equal linkName (string permalink) ]
|
||||
conn.customSingle
|
||||
$"""{Document.Query.selectByWebLog Table.Page} AND {Query.whereByField linkParam "@link"}"""
|
||||
(addFieldParam "@link" linkParam [ webLogParam webLogId ])
|
||||
pageWithoutLinks
|
||||
(Query.byFields (Query.find Table.Page) All fields) (addFieldParams fields []) pageWithoutLinks
|
||||
|
||||
/// Find the current permalink within a set of potential prior permalinks for the given web log
|
||||
let findCurrentPermalink (permalinks: Permalink list) webLogId =
|
||||
log.LogTrace "Page.findCurrentPermalink"
|
||||
let linkSql, linkParams = inJsonArray Table.Page (nameof Page.Empty.PriorPermalinks) "link" permalinks
|
||||
conn.customSingle
|
||||
$"SELECT data ->> '{linkName}' AS permalink
|
||||
FROM {Table.Page}
|
||||
WHERE {Document.Query.whereByWebLog} AND {linkSql}"
|
||||
(webLogParam webLogId :: linkParams)
|
||||
Map.toPermalink
|
||||
let fields =
|
||||
[ webLogField webLogId
|
||||
Field.InArray (nameof Page.Empty.PriorPermalinks) Table.Page (List.map string permalinks) ]
|
||||
let query =
|
||||
(Query.statementWhere (Query.find Table.Page) (Query.whereByFields All fields))
|
||||
.Replace("SELECT data", $"SELECT data->>'{linkName}' AS permalink")
|
||||
conn.customSingle query (addFieldParams fields []) Map.toPermalink
|
||||
|
||||
/// Get all complete pages for the given web log
|
||||
let findFullByWebLog webLogId = backgroundTask {
|
||||
log.LogTrace "Page.findFullByWebLog"
|
||||
let! pages = Document.findByWebLog<Page> Table.Page webLogId conn
|
||||
let! pages = conn.findByFields<Page> Table.Page Any [ webLogField webLogId ]
|
||||
let! withRevs = pages |> List.map appendPageRevisions |> Task.WhenAll
|
||||
return List.ofArray withRevs
|
||||
}
|
||||
@ -130,18 +133,17 @@ type SQLitePageData(conn: SqliteConnection, log: ILogger) =
|
||||
/// Get all listed pages for the given web log (without revisions or text)
|
||||
let findListed webLogId =
|
||||
log.LogTrace "Page.findListed"
|
||||
let fields = [ webLogField webLogId; Field.Equal pgListName true ]
|
||||
conn.customList
|
||||
$"""{Document.Query.selectByWebLog Table.Page} AND {Query.whereByField (Field.EQ pgListName "") "true"}
|
||||
ORDER BY LOWER({titleField})"""
|
||||
[ webLogParam webLogId ]
|
||||
(fun rdr -> { fromData<Page> rdr with Text = "" })
|
||||
(sortedPages fields) (addFieldParams fields []) (fun rdr -> { fromData<Page> rdr with Text = "" })
|
||||
|
||||
/// Get a page of pages for the given web log (without revisions)
|
||||
let findPageOfPages webLogId pageNbr =
|
||||
log.LogTrace "Page.findPageOfPages"
|
||||
let field = [ webLogField webLogId ]
|
||||
conn.customList
|
||||
$"{Document.Query.selectByWebLog Table.Page} ORDER BY LOWER({titleField}) LIMIT @pageSize OFFSET @toSkip"
|
||||
[ webLogParam webLogId; SqliteParameter("@pageSize", 26); SqliteParameter("@toSkip", (pageNbr - 1) * 25) ]
|
||||
$"{sortedPages field} LIMIT @pageSize OFFSET @toSkip"
|
||||
(addFieldParams field [ sqlParam "@pageSize" 26; sqlParam "@toSkip" ((pageNbr - 1) * 25) ])
|
||||
(fun rdr -> { pageWithoutLinks rdr with Metadata = [] })
|
||||
|
||||
/// Update a page
|
||||
|
@ -16,7 +16,7 @@ type SQLitePostData(conn: SqliteConnection, log: ILogger) =
|
||||
let linkName = nameof Post.Empty.Permalink
|
||||
|
||||
/// The JSON field for when the post was published
|
||||
let publishField = $"data ->> '{nameof Post.Empty.PublishedOn}'"
|
||||
let publishName = nameof Post.Empty.PublishedOn
|
||||
|
||||
/// The name of the JSON field for the post's status
|
||||
let statName = nameof Post.Empty.Status
|
||||
@ -31,7 +31,10 @@ type SQLitePostData(conn: SqliteConnection, log: ILogger) =
|
||||
}
|
||||
|
||||
/// The SELECT statement to retrieve posts with a web log ID parameter
|
||||
let postByWebLog = Document.Query.selectByWebLog Table.Post
|
||||
let postByWebLog =
|
||||
Query.statementWhere
|
||||
(Query.find Table.Post)
|
||||
(Query.whereByFields Any [ { Field.Equal "WebLogId" "" with ParameterName = Some "@webLogId" } ])
|
||||
|
||||
/// Return a post with no revisions or prior permalinks
|
||||
let postWithoutLinks rdr =
|
||||
@ -43,7 +46,7 @@ type SQLitePostData(conn: SqliteConnection, log: ILogger) =
|
||||
|
||||
/// The SELECT statement to retrieve published posts with a web log ID parameter
|
||||
let publishedPostByWebLog =
|
||||
$"""{postByWebLog} AND {Query.whereByField (Field.EQ statName "") $"'{string Published}'"}"""
|
||||
$"{postByWebLog} AND data->>'{statName}' = '{string Published}'"
|
||||
|
||||
/// Update a post's revisions
|
||||
let updatePostRevisions (postId: PostId) oldRevs newRevs =
|
||||
@ -60,18 +63,16 @@ type SQLitePostData(conn: SqliteConnection, log: ILogger) =
|
||||
}
|
||||
|
||||
/// Count posts in a status for the given web log
|
||||
let countByStatus (status: PostStatus) webLogId =
|
||||
let countByStatus (status: PostStatus) webLogId = backgroundTask {
|
||||
log.LogTrace "Post.countByStatus"
|
||||
let statParam = Field.EQ statName (string status)
|
||||
conn.customScalar
|
||||
$"""{Document.Query.countByWebLog Table.Post} AND {Query.whereByField statParam "@status"}"""
|
||||
(addFieldParam "@status" statParam [ webLogParam webLogId ])
|
||||
(toCount >> int)
|
||||
let! count = conn.countByFields Table.Post All [ webLogField webLogId; Field.Equal statName (string status) ]
|
||||
return int count
|
||||
}
|
||||
|
||||
/// Find a post by its ID for the given web log (excluding revisions)
|
||||
let findById postId webLogId = backgroundTask {
|
||||
let findById (postId: PostId) webLogId = backgroundTask {
|
||||
log.LogTrace "Post.findById"
|
||||
match! Document.findByIdAndWebLog<PostId, Post> Table.Post postId webLogId conn with
|
||||
match! conn.findFirstByFields<Post> Table.Post All [ idField postId; webLogField webLogId ] with
|
||||
| Some post -> return Some { post with PriorPermalinks = [] }
|
||||
| None -> return None
|
||||
}
|
||||
@ -79,16 +80,14 @@ type SQLitePostData(conn: SqliteConnection, log: ILogger) =
|
||||
/// Find a post by its permalink for the given web log (excluding revisions)
|
||||
let findByPermalink (permalink: Permalink) webLogId =
|
||||
log.LogTrace "Post.findByPermalink"
|
||||
let linkParam = Field.EQ linkName (string permalink)
|
||||
let fields = [ webLogField webLogId; Field.Equal linkName (string permalink) ]
|
||||
conn.customSingle
|
||||
$"""{Document.Query.selectByWebLog Table.Post} AND {Query.whereByField linkParam "@link"}"""
|
||||
(addFieldParam "@link" linkParam [ webLogParam webLogId ])
|
||||
postWithoutLinks
|
||||
(Query.byFields (Query.find Table.Post) All fields) (addFieldParams fields []) postWithoutLinks
|
||||
|
||||
/// Find a complete post by its ID for the given web log
|
||||
let findFullById postId webLogId = backgroundTask {
|
||||
log.LogTrace "Post.findFullById"
|
||||
match! Document.findByIdAndWebLog<PostId, Post> Table.Post postId webLogId conn with
|
||||
match! conn.findFirstByFields<Post> Table.Post All [ idField postId; webLogField webLogId ] with
|
||||
| Some post ->
|
||||
let! post = appendPostRevisions post
|
||||
return Some post
|
||||
@ -101,10 +100,12 @@ type SQLitePostData(conn: SqliteConnection, log: ILogger) =
|
||||
match! findById postId webLogId with
|
||||
| Some _ ->
|
||||
do! conn.customNonQuery
|
||||
$"""DELETE FROM {Table.PostRevision} WHERE post_id = @id;
|
||||
DELETE FROM {Table.PostComment}
|
||||
WHERE {Query.whereByField (Field.EQ (nameof Comment.Empty.PostId) "") "@id"};
|
||||
{Query.Delete.byId Table.Post}"""
|
||||
$"""{Query.delete Table.PostRevision} WHERE post_id = @id;
|
||||
{Query.byFields
|
||||
(Query.delete Table.PostComment)
|
||||
Any
|
||||
[ { Field.EQ (nameof Comment.Empty.PostId) postId with ParameterName = Some "@id" }]};
|
||||
{Query.byId (Query.delete Table.Post) (string postId)}"""
|
||||
[ idParam postId ]
|
||||
return true
|
||||
| None -> return false
|
||||
@ -113,18 +114,18 @@ type SQLitePostData(conn: SqliteConnection, log: ILogger) =
|
||||
/// Find the current permalink from a list of potential prior permalinks for the given web log
|
||||
let findCurrentPermalink (permalinks: Permalink list) webLogId =
|
||||
log.LogTrace "Post.findCurrentPermalink"
|
||||
let linkSql, linkParams = inJsonArray Table.Post (nameof Post.Empty.PriorPermalinks) "link" permalinks
|
||||
conn.customSingle
|
||||
$"SELECT data ->> '{linkName}' AS permalink
|
||||
FROM {Table.Post}
|
||||
WHERE {Document.Query.whereByWebLog} AND {linkSql}"
|
||||
(webLogParam webLogId :: linkParams)
|
||||
Map.toPermalink
|
||||
let fields =
|
||||
[ webLogField webLogId
|
||||
Field.InArray (nameof Post.Empty.PriorPermalinks) Table.Post (List.map string permalinks) ]
|
||||
let query =
|
||||
(Query.statementWhere (Query.find Table.Post) (Query.whereByFields All fields))
|
||||
.Replace("SELECT data", $"SELECT data->>'{linkName}' AS permalink")
|
||||
conn.customSingle query (addFieldParams fields []) Map.toPermalink
|
||||
|
||||
/// Get all complete posts for the given web log
|
||||
let findFullByWebLog webLogId = backgroundTask {
|
||||
log.LogTrace "Post.findFullByWebLog"
|
||||
let! posts = Document.findByWebLog<Post> Table.Post webLogId conn
|
||||
let! posts = conn.findByFields<Post> Table.Post Any [ webLogField webLogId ]
|
||||
let! withRevs = posts |> List.map appendPostRevisions |> Task.WhenAll
|
||||
return List.ofArray withRevs
|
||||
}
|
||||
@ -132,21 +133,22 @@ type SQLitePostData(conn: SqliteConnection, log: ILogger) =
|
||||
/// Get a page of categorized posts for the given web log (excludes revisions)
|
||||
let findPageOfCategorizedPosts webLogId (categoryIds: CategoryId list) pageNbr postsPerPage =
|
||||
log.LogTrace "Post.findPageOfCategorizedPosts"
|
||||
let catSql, catParams = inJsonArray Table.Post (nameof Post.Empty.CategoryIds) "catId" categoryIds
|
||||
let catIdField = Field.InArray (nameof Post.Empty.CategoryIds) Table.Post (List.map string categoryIds)
|
||||
conn.customList
|
||||
$"{publishedPostByWebLog} AND {catSql}
|
||||
ORDER BY {publishField} DESC
|
||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|
||||
(webLogParam webLogId :: catParams)
|
||||
$"""{publishedPostByWebLog} AND {Query.whereByFields Any [ catIdField ]}
|
||||
{Query.orderBy [ Field.Named $"{publishName} DESC" ] SQLite}
|
||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
|
||||
(addFieldParams [ webLogField webLogId; catIdField ] [])
|
||||
postWithoutLinks
|
||||
|
||||
/// Get a page of posts for the given web log (excludes text and revisions)
|
||||
let findPageOfPosts webLogId pageNbr postsPerPage =
|
||||
log.LogTrace "Post.findPageOfPosts"
|
||||
let order =
|
||||
Query.orderBy
|
||||
[ Field.Named $"{publishName} DESC NULLS FIRST"; Field.Named (nameof Post.Empty.UpdatedOn) ] SQLite
|
||||
conn.customList
|
||||
$"{postByWebLog}
|
||||
ORDER BY {publishField} DESC NULLS FIRST, data ->> '{nameof Post.Empty.UpdatedOn}'
|
||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|
||||
$"{postByWebLog}{order} LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|
||||
[ webLogParam webLogId ]
|
||||
postWithoutText
|
||||
|
||||
@ -154,36 +156,39 @@ type SQLitePostData(conn: SqliteConnection, log: ILogger) =
|
||||
let findPageOfPublishedPosts webLogId pageNbr postsPerPage =
|
||||
log.LogTrace "Post.findPageOfPublishedPosts"
|
||||
conn.customList
|
||||
$"{publishedPostByWebLog}
|
||||
ORDER BY {publishField} DESC
|
||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|
||||
$"""{publishedPostByWebLog}
|
||||
{Query.orderBy [ Field.Named $"{publishName} DESC" ] SQLite}
|
||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
|
||||
[ webLogParam webLogId ]
|
||||
postWithoutLinks
|
||||
|
||||
/// Get a page of tagged posts for the given web log (excludes revisions)
|
||||
let findPageOfTaggedPosts webLogId (tag : string) pageNbr postsPerPage =
|
||||
log.LogTrace "Post.findPageOfTaggedPosts"
|
||||
let tagSql, tagParams = inJsonArray Table.Post (nameof Post.Empty.Tags) "tag" [ tag ]
|
||||
let tagField = Field.InArray (nameof Post.Empty.Tags) Table.Post [ tag ]
|
||||
conn.customList
|
||||
$"{publishedPostByWebLog} AND {tagSql}
|
||||
ORDER BY {publishField} DESC
|
||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"
|
||||
(webLogParam webLogId :: tagParams)
|
||||
$"""{publishedPostByWebLog} AND {Query.whereByFields Any [ tagField ]}
|
||||
{Query.orderBy [ Field.Named $"{publishName} DESC" ] SQLite}
|
||||
LIMIT {postsPerPage + 1} OFFSET {(pageNbr - 1) * postsPerPage}"""
|
||||
(addFieldParams [ webLogField webLogId; tagField ] [])
|
||||
postWithoutLinks
|
||||
|
||||
/// Find the next newest and oldest post from a publish date for the given web log
|
||||
let findSurroundingPosts webLogId (publishedOn : Instant) = backgroundTask {
|
||||
log.LogTrace "Post.findSurroundingPosts"
|
||||
let! older =
|
||||
let adjacent op order =
|
||||
let fields = [
|
||||
webLogField webLogId
|
||||
Field.Equal (nameof Post.Empty.Status) (string Published)
|
||||
(if op = "<" then Field.Less else Field.Greater) publishName (instantParam publishedOn)
|
||||
]
|
||||
conn.customSingle
|
||||
$"{publishedPostByWebLog} AND {publishField} < @publishedOn ORDER BY {publishField} DESC LIMIT 1"
|
||||
[ webLogParam webLogId; SqliteParameter("@publishedOn", instantParam publishedOn) ]
|
||||
postWithoutLinks
|
||||
let! newer =
|
||||
conn.customSingle
|
||||
$"{publishedPostByWebLog} AND {publishField} > @publishedOn ORDER BY {publishField} LIMIT 1"
|
||||
[ webLogParam webLogId; SqliteParameter("@publishedOn", instantParam publishedOn) ]
|
||||
(Query.byFields (Query.find Table.Post) All fields
|
||||
+ Query.orderBy [ Field.Named (publishName + order) ] SQLite + " LIMIT 1")
|
||||
(addFieldParams fields [])
|
||||
postWithoutLinks
|
||||
let! older = adjacent "<" " DESC"
|
||||
let! newer = adjacent ">" ""
|
||||
return older, newer
|
||||
}
|
||||
|
||||
|
@ -11,9 +11,9 @@ open MyWebLog.Data
|
||||
type SQLiteTagMapData(conn: SqliteConnection, log: ILogger) =
|
||||
|
||||
/// Find a tag mapping by its ID for the given web log
|
||||
let findById tagMapId webLogId =
|
||||
let findById (tagMapId: TagMapId) webLogId =
|
||||
log.LogTrace "TagMap.findById"
|
||||
Document.findByIdAndWebLog<TagMapId, TagMap> Table.TagMap tagMapId webLogId conn
|
||||
conn.findFirstByFields<TagMap> Table.TagMap All [ idField tagMapId; webLogField webLogId ]
|
||||
|
||||
/// Delete a tag mapping for the given web log
|
||||
let delete tagMapId webLogId = backgroundTask {
|
||||
@ -28,25 +28,18 @@ type SQLiteTagMapData(conn: SqliteConnection, log: ILogger) =
|
||||
/// Find a tag mapping by its URL value for the given web log
|
||||
let findByUrlValue (urlValue: string) webLogId =
|
||||
log.LogTrace "TagMap.findByUrlValue"
|
||||
let urlParam = Field.EQ (nameof TagMap.Empty.UrlValue) urlValue
|
||||
conn.customSingle
|
||||
$"""{Document.Query.selectByWebLog Table.TagMap} AND {Query.whereByField urlParam "@urlValue"}"""
|
||||
(addFieldParam "@urlValue" urlParam [ webLogParam webLogId ])
|
||||
fromData<TagMap>
|
||||
conn.findFirstByFields<TagMap>
|
||||
Table.TagMap All [ webLogField webLogId; Field.Equal (nameof TagMap.Empty.UrlValue) urlValue ]
|
||||
|
||||
/// Get all tag mappings for the given web log
|
||||
let findByWebLog webLogId =
|
||||
log.LogTrace "TagMap.findByWebLog"
|
||||
Document.findByWebLog<TagMap> Table.TagMap webLogId conn
|
||||
conn.findByFields<TagMap> Table.TagMap Any [ webLogField webLogId ]
|
||||
|
||||
/// Find any tag mappings in a list of tags for the given web log
|
||||
let findMappingForTags (tags: string list) webLogId =
|
||||
log.LogTrace "TagMap.findMappingForTags"
|
||||
let mapSql, mapParams = inClause $"AND data ->> '{nameof TagMap.Empty.Tag}'" "tag" id tags
|
||||
conn.customList
|
||||
$"{Document.Query.selectByWebLog Table.TagMap} {mapSql}"
|
||||
(webLogParam webLogId :: mapParams)
|
||||
fromData<TagMap>
|
||||
conn.findByFields<TagMap> Table.TagMap All [ webLogField webLogId; Field.In (nameof TagMap.Empty.Tag) tags ]
|
||||
|
||||
/// Save a tag mapping
|
||||
let save (tagMap: TagMap) =
|
||||
|
@ -10,8 +10,8 @@ open MyWebLog.Data
|
||||
/// 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}'"
|
||||
/// The name of the theme ID field
|
||||
let idName = nameof Theme.Empty.Id
|
||||
|
||||
/// Convert a document to a theme with no template text
|
||||
let withoutTemplateText (rdr: SqliteDataReader) =
|
||||
@ -25,9 +25,10 @@ type SQLiteThemeData(conn : SqliteConnection, log: ILogger) =
|
||||
/// Retrieve all themes (except 'admin'; excludes template text)
|
||||
let all () =
|
||||
log.LogTrace "Theme.all"
|
||||
let fields = [ Field.NE idName "admin" ]
|
||||
conn.customList
|
||||
$"{Query.selectFromTable Table.Theme} WHERE {idField} <> 'admin' ORDER BY {idField}"
|
||||
[]
|
||||
(Query.byFields (Query.find Table.Theme) Any fields + Query.orderBy [ Field.Named idName ] SQLite)
|
||||
(addFieldParams fields [])
|
||||
withoutTemplateText
|
||||
|
||||
/// Does a given theme exist?
|
||||
@ -43,7 +44,7 @@ type SQLiteThemeData(conn : SqliteConnection, log: ILogger) =
|
||||
/// Find a theme by its ID (excludes the text of templates)
|
||||
let findByIdWithoutText (themeId: ThemeId) =
|
||||
log.LogTrace "Theme.findByIdWithoutText"
|
||||
conn.customSingle (Query.Find.byId Table.Theme) [ idParam themeId ] withoutTemplateText
|
||||
conn.customSingle (Query.byId (Query.find Table.Theme) (string themeId)) [ idParam themeId ] withoutTemplateText
|
||||
|
||||
/// Delete a theme by its ID
|
||||
let delete themeId = backgroundTask {
|
||||
@ -51,7 +52,8 @@ type SQLiteThemeData(conn : SqliteConnection, log: ILogger) =
|
||||
match! findByIdWithoutText themeId with
|
||||
| Some _ ->
|
||||
do! conn.customNonQuery
|
||||
$"DELETE FROM {Table.ThemeAsset} WHERE theme_id = @id; {Query.Delete.byId Table.Theme}"
|
||||
$"{Query.delete Table.ThemeAsset} WHERE theme_id = @id;
|
||||
{Query.byId (Query.delete Table.Theme) (string themeId)}"
|
||||
[ idParam themeId ]
|
||||
return true
|
||||
| None -> return false
|
||||
@ -89,7 +91,7 @@ type SQLiteThemeAssetData(conn : SqliteConnection, log: ILogger) =
|
||||
/// Delete all assets for the given theme
|
||||
let deleteByTheme (themeId: ThemeId) =
|
||||
log.LogTrace "ThemeAsset.deleteByTheme"
|
||||
conn.customNonQuery $"DELETE FROM {Table.ThemeAsset} WHERE theme_id = @id" [ idParam themeId ]
|
||||
conn.customNonQuery $"{Query.delete Table.ThemeAsset} WHERE theme_id = @id" [ idParam themeId ]
|
||||
|
||||
/// Find a theme asset by its ID
|
||||
let findById assetId =
|
||||
|
@ -23,25 +23,26 @@ type SQLiteWebLogData(conn: SqliteConnection, log: ILogger) =
|
||||
/// Delete a web log by its ID
|
||||
let delete webLogId =
|
||||
log.LogTrace "WebLog.delete"
|
||||
let webLogMatches = Query.whereByField (Field.EQ "WebLogId" "") "@webLogId"
|
||||
let subQuery table = $"(SELECT data ->> 'Id' FROM {table} WHERE {webLogMatches})"
|
||||
let webLogMatches =
|
||||
Query.whereByFields Any [ { Field.Equal "WebLogId" "" with ParameterName = Some "@webLogId" } ]
|
||||
let subQuery table = $"(SELECT data->>'Id' FROM {table} WHERE {webLogMatches})"
|
||||
Custom.nonQuery
|
||||
$"""DELETE FROM {Table.PostComment} WHERE data ->> 'PostId' IN {subQuery Table.Post};
|
||||
DELETE FROM {Table.PostRevision} WHERE post_id IN {subQuery Table.Post};
|
||||
DELETE FROM {Table.PageRevision} WHERE page_id IN {subQuery Table.Page};
|
||||
DELETE FROM {Table.Post} WHERE {webLogMatches};
|
||||
DELETE FROM {Table.Page} WHERE {webLogMatches};
|
||||
DELETE FROM {Table.Category} WHERE {webLogMatches};
|
||||
DELETE FROM {Table.TagMap} WHERE {webLogMatches};
|
||||
DELETE FROM {Table.Upload} WHERE web_log_id = @webLogId;
|
||||
DELETE FROM {Table.WebLogUser} WHERE {webLogMatches};
|
||||
DELETE FROM {Table.WebLog} WHERE {Query.whereById "@webLogId"}"""
|
||||
$"""{Query.delete Table.PostComment} WHERE data ->> 'PostId' IN {subQuery Table.Post};
|
||||
{Query.delete Table.PostRevision} WHERE post_id IN {subQuery Table.Post};
|
||||
{Query.delete Table.PageRevision} WHERE page_id IN {subQuery Table.Page};
|
||||
{Query.delete Table.Post} WHERE {webLogMatches};
|
||||
{Query.delete Table.Page} WHERE {webLogMatches};
|
||||
{Query.delete Table.Category} WHERE {webLogMatches};
|
||||
{Query.delete Table.TagMap} WHERE {webLogMatches};
|
||||
{Query.delete Table.Upload} WHERE web_log_id = @webLogId;
|
||||
{Query.delete Table.WebLogUser} WHERE {webLogMatches};
|
||||
{Query.delete Table.WebLog} WHERE {Query.whereById "@webLogId"}"""
|
||||
[ webLogParam webLogId ]
|
||||
|
||||
/// Find a web log by its host (URL base)
|
||||
let findByHost (url: string) =
|
||||
log.LogTrace "WebLog.findByHost"
|
||||
conn.findFirstByField<WebLog> Table.WebLog (Field.EQ (nameof WebLog.Empty.UrlBase) url)
|
||||
conn.findFirstByFields<WebLog> Table.WebLog Any [ Field.Equal (nameof WebLog.Empty.UrlBase) url ]
|
||||
|
||||
/// Find a web log by its ID
|
||||
let findById webLogId =
|
||||
|
@ -16,17 +16,18 @@ type SQLiteWebLogUserData(conn: SqliteConnection, log: ILogger) =
|
||||
conn.insert<WebLogUser> Table.WebLogUser user
|
||||
|
||||
/// Find a user by their ID for the given web log
|
||||
let findById userId webLogId =
|
||||
let findById (userId: WebLogUserId) webLogId =
|
||||
log.LogTrace "WebLogUser.findById"
|
||||
Document.findByIdAndWebLog<WebLogUserId, WebLogUser> Table.WebLogUser userId webLogId conn
|
||||
conn.findFirstByFields<WebLogUser> Table.WebLogUser All [ idField userId; webLogField webLogId ]
|
||||
|
||||
/// Delete a user if they have no posts or pages
|
||||
let delete userId webLogId = backgroundTask {
|
||||
log.LogTrace "WebLogUser.delete"
|
||||
match! findById userId webLogId with
|
||||
| Some _ ->
|
||||
let! pageCount = conn.countByField Table.Page (Field.EQ (nameof Page.Empty.AuthorId) (string userId))
|
||||
let! postCount = conn.countByField Table.Post (Field.EQ (nameof Post.Empty.AuthorId) (string userId))
|
||||
let author = [ Field.Equal (nameof Page.Empty.AuthorId) (string userId) ]
|
||||
let! pageCount = conn.countByFields Table.Page Any author
|
||||
let! postCount = conn.countByFields Table.Post Any author
|
||||
if pageCount + postCount > 0 then
|
||||
return Error "User has pages or posts; cannot delete"
|
||||
else
|
||||
@ -38,27 +39,24 @@ type SQLiteWebLogUserData(conn: SqliteConnection, log: ILogger) =
|
||||
/// Find a user by their e-mail address for the given web log
|
||||
let findByEmail (email: string) webLogId =
|
||||
log.LogTrace "WebLogUser.findByEmail"
|
||||
let emailParam = Field.EQ (nameof WebLogUser.Empty.Email) email
|
||||
conn.customSingle
|
||||
$"""{Document.Query.selectByWebLog Table.WebLogUser}
|
||||
AND {Query.whereByField emailParam "@email"}"""
|
||||
(addFieldParam "@email" emailParam [ webLogParam webLogId ])
|
||||
fromData<WebLogUser>
|
||||
conn.findFirstByFields
|
||||
Table.WebLogUser All [ webLogField webLogId; Field.Equal (nameof WebLogUser.Empty.Email) email ]
|
||||
|
||||
/// Get all users for the given web log
|
||||
let findByWebLog webLogId = backgroundTask {
|
||||
log.LogTrace "WebLogUser.findByWebLog"
|
||||
let! users = Document.findByWebLog<WebLogUser> Table.WebLogUser webLogId conn
|
||||
let! users = conn.findByFields<WebLogUser> Table.WebLogUser Any [ webLogField webLogId ]
|
||||
return users |> List.sortBy _.PreferredName.ToLowerInvariant()
|
||||
}
|
||||
|
||||
/// Find the names of users by their IDs for the given web log
|
||||
let findNames webLogId (userIds: WebLogUserId list) =
|
||||
log.LogTrace "WebLogUser.findNames"
|
||||
let nameSql, nameParams = inClause $"AND data ->> '{nameof WebLogUser.Empty.Id}'" "id" string userIds
|
||||
let fields = [ webLogField webLogId; Field.In (nameof WebLogUser.Empty.Id) (List.map string userIds) ]
|
||||
let query = Query.statementWhere (Query.find Table.WebLogUser) (Query.whereByFields All fields)
|
||||
conn.customList
|
||||
$"{Document.Query.selectByWebLog Table.WebLogUser} {nameSql}"
|
||||
(webLogParam webLogId :: nameParams)
|
||||
query
|
||||
(addFieldParams fields [])
|
||||
(fun rdr ->
|
||||
let user = fromData<WebLogUser> rdr
|
||||
{ Name = string user.Id; Value = user.DisplayName })
|
||||
|
@ -1,7 +1,6 @@
|
||||
namespace MyWebLog.Data
|
||||
|
||||
open System
|
||||
open System.Threading.Tasks
|
||||
open BitBadger.Documents
|
||||
open BitBadger.Documents.Sqlite
|
||||
open Microsoft.Data.Sqlite
|
||||
@ -24,98 +23,107 @@ type SQLiteData(conn: SqliteConnection, log: ILogger<SQLiteData>, ser: JsonSeria
|
||||
let needsTable table =
|
||||
not (List.contains table tables)
|
||||
|
||||
let jsonTable table =
|
||||
$"{Query.Definition.ensureTable table}; {Query.Definition.ensureKey table}"
|
||||
let creatingTable = "Creating {Table} table..."
|
||||
|
||||
let tasks =
|
||||
seq {
|
||||
// Theme tables
|
||||
if needsTable Table.Theme then jsonTable Table.Theme
|
||||
if needsTable Table.ThemeAsset then
|
||||
// Theme tables
|
||||
if needsTable Table.Theme then
|
||||
log.LogInformation(creatingTable, Table.Theme)
|
||||
do! conn.ensureTable Table.Theme
|
||||
|
||||
if needsTable Table.ThemeAsset then
|
||||
log.LogInformation(creatingTable, Table.ThemeAsset)
|
||||
do! conn.customNonQuery
|
||||
$"CREATE TABLE {Table.ThemeAsset} (
|
||||
theme_id TEXT NOT NULL,
|
||||
path TEXT NOT NULL,
|
||||
updated_on TEXT NOT NULL,
|
||||
data BLOB NOT NULL,
|
||||
PRIMARY KEY (theme_id, path))"
|
||||
|
||||
// Web log table
|
||||
if needsTable Table.WebLog then jsonTable Table.WebLog
|
||||
|
||||
// Category table
|
||||
if needsTable Table.Category then
|
||||
$"""{jsonTable Table.Category};
|
||||
{Query.Definition.ensureIndexOn Table.Category "web_log" [ nameof Category.Empty.WebLogId ]}"""
|
||||
|
||||
// Web log user table
|
||||
if needsTable Table.WebLogUser then
|
||||
$"""{jsonTable Table.WebLogUser};
|
||||
{Query.Definition.ensureIndexOn
|
||||
Table.WebLogUser
|
||||
"email"
|
||||
[ nameof WebLogUser.Empty.WebLogId; nameof WebLogUser.Empty.Email ]}"""
|
||||
|
||||
// Page tables
|
||||
if needsTable Table.Page then
|
||||
$"""{jsonTable Table.Page};
|
||||
{Query.Definition.ensureIndexOn Table.Page "author" [ nameof Page.Empty.AuthorId ]};
|
||||
{Query.Definition.ensureIndexOn
|
||||
Table.Page "permalink" [ nameof Page.Empty.WebLogId; nameof Page.Empty.Permalink ]}"""
|
||||
if needsTable Table.PageRevision then
|
||||
PRIMARY KEY (theme_id, path))" []
|
||||
|
||||
// Web log table
|
||||
if needsTable Table.WebLog then
|
||||
log.LogInformation(creatingTable, Table.WebLog)
|
||||
do! conn.ensureTable Table.WebLog
|
||||
|
||||
// Category table
|
||||
if needsTable Table.Category then
|
||||
log.LogInformation(creatingTable, Table.Category)
|
||||
do! conn.ensureTable Table.Category
|
||||
do! conn.ensureFieldIndex Table.Category "web_log" [ nameof Category.Empty.WebLogId ]
|
||||
|
||||
// Web log user table
|
||||
if needsTable Table.WebLogUser then
|
||||
log.LogInformation(creatingTable, Table.WebLogUser)
|
||||
do! conn.ensureTable Table.WebLogUser
|
||||
do! conn.ensureFieldIndex
|
||||
Table.WebLogUser "email" [ nameof WebLogUser.Empty.WebLogId; nameof WebLogUser.Empty.Email ]
|
||||
|
||||
// Page tables
|
||||
if needsTable Table.Page then
|
||||
log.LogInformation(creatingTable, Table.Page)
|
||||
do! conn.ensureTable Table.Page
|
||||
do! conn.ensureFieldIndex Table.Page "author" [ nameof Page.Empty.AuthorId ]
|
||||
do! conn.ensureFieldIndex Table.Page "permalink" [ nameof Page.Empty.WebLogId; nameof Page.Empty.Permalink ]
|
||||
|
||||
if needsTable Table.PageRevision then
|
||||
log.LogInformation(creatingTable, Table.PageRevision)
|
||||
do! conn.customNonQuery
|
||||
$"CREATE TABLE {Table.PageRevision} (
|
||||
page_id TEXT NOT NULL,
|
||||
as_of TEXT NOT NULL,
|
||||
revision_text TEXT NOT NULL,
|
||||
PRIMARY KEY (page_id, as_of))"
|
||||
|
||||
// Post tables
|
||||
if needsTable Table.Post then
|
||||
$"""{jsonTable Table.Post};
|
||||
{Query.Definition.ensureIndexOn Table.Post "author" [ nameof Post.Empty.AuthorId ]};
|
||||
{Query.Definition.ensureIndexOn
|
||||
Table.Post "permalink" [ nameof Post.Empty.WebLogId; nameof Post.Empty.Permalink ]};
|
||||
{Query.Definition.ensureIndexOn
|
||||
Table.Post
|
||||
"status"
|
||||
[ nameof Post.Empty.WebLogId; nameof Post.Empty.Status; nameof Post.Empty.UpdatedOn ]}"""
|
||||
// TODO: index categories by post?
|
||||
if needsTable Table.PostRevision then
|
||||
PRIMARY KEY (page_id, as_of))" []
|
||||
|
||||
// Post tables
|
||||
if needsTable Table.Post then
|
||||
log.LogInformation(creatingTable, Table.Post)
|
||||
do! conn.ensureTable Table.Post
|
||||
do! conn.ensureFieldIndex Table.Post "author" [ nameof Post.Empty.AuthorId ]
|
||||
do! conn.ensureFieldIndex Table.Post "permalink" [ nameof Post.Empty.WebLogId; nameof Post.Empty.Permalink ]
|
||||
do! conn.ensureFieldIndex
|
||||
Table.Post
|
||||
"status"
|
||||
[ nameof Post.Empty.WebLogId; nameof Post.Empty.Status; nameof Post.Empty.UpdatedOn ]
|
||||
// TODO: index categories by post?
|
||||
|
||||
if needsTable Table.PostRevision then
|
||||
log.LogInformation(creatingTable, Table.PostRevision)
|
||||
do! conn.customNonQuery
|
||||
$"CREATE TABLE {Table.PostRevision} (
|
||||
post_id TEXT NOT NULL,
|
||||
as_of TEXT NOT NULL,
|
||||
revision_text TEXT NOT NULL,
|
||||
PRIMARY KEY (post_id, as_of))"
|
||||
if needsTable Table.PostComment then
|
||||
$"""{jsonTable Table.PostComment};
|
||||
{Query.Definition.ensureIndexOn Table.PostComment "post" [ nameof Comment.Empty.PostId ]}"""
|
||||
|
||||
// Tag map table
|
||||
if needsTable Table.TagMap then
|
||||
$"""{jsonTable Table.TagMap};
|
||||
{Query.Definition.ensureIndexOn
|
||||
Table.TagMap "url" [ nameof TagMap.Empty.WebLogId; nameof TagMap.Empty.UrlValue ]}"""
|
||||
|
||||
// Uploaded file table
|
||||
if needsTable Table.Upload then
|
||||
PRIMARY KEY (post_id, as_of))" []
|
||||
|
||||
if needsTable Table.PostComment then
|
||||
log.LogInformation(creatingTable, Table.PostComment)
|
||||
do! conn.ensureTable Table.PostComment
|
||||
do! conn.ensureFieldIndex Table.PostComment "post" [ nameof Comment.Empty.PostId ]
|
||||
|
||||
// Tag map table
|
||||
if needsTable Table.TagMap then
|
||||
log.LogInformation(creatingTable, Table.TagMap)
|
||||
do! conn.ensureTable Table.TagMap
|
||||
do! conn.ensureFieldIndex Table.TagMap "url" [ nameof TagMap.Empty.WebLogId; nameof TagMap.Empty.UrlValue ]
|
||||
|
||||
// Uploaded file table
|
||||
if needsTable Table.Upload then
|
||||
log.LogInformation(creatingTable, Table.Upload)
|
||||
do! conn.customNonQuery
|
||||
$"CREATE TABLE {Table.Upload} (
|
||||
id TEXT PRIMARY KEY,
|
||||
web_log_id TEXT NOT NULL,
|
||||
path TEXT NOT NULL,
|
||||
updated_on TEXT NOT NULL,
|
||||
data BLOB NOT NULL);
|
||||
CREATE INDEX idx_{Table.Upload}_path ON {Table.Upload} (web_log_id, path)"
|
||||
|
||||
// Database version table
|
||||
if needsTable Table.DbVersion then
|
||||
$"CREATE TABLE {Table.DbVersion} (id TEXT PRIMARY KEY);
|
||||
INSERT INTO {Table.DbVersion} VALUES ('{Utils.Migration.currentDbVersion}')"
|
||||
}
|
||||
|> Seq.map (fun sql ->
|
||||
log.LogInformation $"""Creating {(sql.Replace("IF NOT EXISTS ", "").Split ' ')[2]} table..."""
|
||||
conn.customNonQuery sql [])
|
||||
CREATE INDEX idx_{Table.Upload}_path ON {Table.Upload} (web_log_id, path)" []
|
||||
|
||||
let! _ = Task.WhenAll tasks
|
||||
()
|
||||
// Database version table
|
||||
if needsTable Table.DbVersion then
|
||||
log.LogInformation(creatingTable, Table.DbVersion)
|
||||
do! conn.customNonQuery
|
||||
$"CREATE TABLE {Table.DbVersion} (id TEXT PRIMARY KEY);
|
||||
INSERT INTO {Table.DbVersion} VALUES ('{Utils.Migration.currentDbVersion}')" []
|
||||
}
|
||||
|
||||
/// Set the database version to the specified version
|
||||
|
@ -10,8 +10,8 @@
|
||||
<PackageReference Include="Markdig" Version="0.37.0" />
|
||||
<PackageReference Include="Markdown.ColorCode" Version="2.2.2" />
|
||||
<PackageReference Include="Newtonsoft.Json" Version="13.0.3" />
|
||||
<PackageReference Include="NodaTime" Version="3.1.11" />
|
||||
<PackageReference Update="FSharp.Core" Version="8.0.300" />
|
||||
<PackageReference Include="NodaTime" Version="3.1.12" />
|
||||
<PackageReference Update="FSharp.Core" Version="8.0.400" />
|
||||
</ItemGroup>
|
||||
|
||||
</Project>
|
||||
|
@ -28,7 +28,7 @@
|
||||
<ItemGroup>
|
||||
<PackageReference Include="Expecto" Version="10.2.1" />
|
||||
<PackageReference Include="ThrowawayDb.Postgres" Version="1.4.0" />
|
||||
<PackageReference Update="FSharp.Core" Version="8.0.300" />
|
||||
<PackageReference Update="FSharp.Core" Version="8.0.400" />
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
|
@ -180,70 +180,6 @@ module CategoryCache =
|
||||
}
|
||||
|
||||
|
||||
/// Cache for parsed templates
|
||||
module TemplateCache =
|
||||
|
||||
open System
|
||||
open System.Text.RegularExpressions
|
||||
open DotLiquid
|
||||
|
||||
/// Cache of parsed templates
|
||||
let private _cache = ConcurrentDictionary<string, Template> ()
|
||||
|
||||
/// Custom include parameter pattern
|
||||
let private hasInclude = Regex("""{% include_template \"(.*)\" %}""", RegexOptions.None, TimeSpan.FromSeconds 2)
|
||||
|
||||
/// Get a template for the given theme and template name
|
||||
let get (themeId: ThemeId) (templateName: string) (data: IData) = backgroundTask {
|
||||
let templatePath = $"{themeId}/{templateName}"
|
||||
match _cache.ContainsKey templatePath with
|
||||
| true -> return Ok _cache[templatePath]
|
||||
| false ->
|
||||
match! data.Theme.FindById themeId with
|
||||
| Some theme ->
|
||||
match theme.Templates |> List.tryFind (fun t -> t.Name = templateName) with
|
||||
| Some template ->
|
||||
let mutable text = template.Text
|
||||
let mutable childNotFound = ""
|
||||
while hasInclude.IsMatch text do
|
||||
let child = hasInclude.Match text
|
||||
let childText =
|
||||
match theme.Templates |> List.tryFind (fun t -> t.Name = child.Groups[1].Value) with
|
||||
| Some childTemplate -> childTemplate.Text
|
||||
| None ->
|
||||
childNotFound <-
|
||||
if childNotFound = "" then child.Groups[1].Value
|
||||
else $"{childNotFound}; {child.Groups[1].Value}"
|
||||
""
|
||||
text <- text.Replace(child.Value, childText)
|
||||
if childNotFound <> "" then
|
||||
let s = if childNotFound.IndexOf ";" >= 0 then "s" else ""
|
||||
return Error $"Could not find the child template{s} {childNotFound} required by {templateName}"
|
||||
else
|
||||
_cache[templatePath] <- Template.Parse(text, SyntaxCompatibility.DotLiquid22)
|
||||
return Ok _cache[templatePath]
|
||||
| None ->
|
||||
return Error $"Theme ID {themeId} does not have a template named {templateName}"
|
||||
| None -> return Error $"Theme ID {themeId} does not exist"
|
||||
}
|
||||
|
||||
/// Get all theme/template names currently cached
|
||||
let allNames () =
|
||||
_cache.Keys |> Seq.sort |> Seq.toList
|
||||
|
||||
/// Invalidate all template cache entries for the given theme ID
|
||||
let invalidateTheme (themeId: ThemeId) =
|
||||
let keyPrefix = string themeId
|
||||
_cache.Keys
|
||||
|> Seq.filter _.StartsWith(keyPrefix)
|
||||
|> List.ofSeq
|
||||
|> List.iter (fun key -> match _cache.TryRemove key with _, _ -> ())
|
||||
|
||||
/// Remove all entries from the template cache
|
||||
let empty () =
|
||||
_cache.Clear()
|
||||
|
||||
|
||||
/// A cache of asset names by themes
|
||||
module ThemeAssetCache =
|
||||
|
||||
|
@ -28,13 +28,13 @@ module Dashboard =
|
||||
ListedPages = listed
|
||||
Categories = cats
|
||||
TopLevelCategories = topCats }
|
||||
return! adminPage "Dashboard" false next ctx (Views.WebLog.dashboard model)
|
||||
return! adminPage "Dashboard" next ctx (Views.WebLog.dashboard model)
|
||||
}
|
||||
|
||||
// GET /admin/administration
|
||||
let admin : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
|
||||
let! themes = ctx.Data.Theme.All()
|
||||
return! adminPage "myWebLog Administration" true next ctx (Views.Admin.dashboard themes)
|
||||
return! adminPage "myWebLog Administration" next ctx (Views.Admin.dashboard themes)
|
||||
}
|
||||
|
||||
/// Redirect the user to the admin dashboard
|
||||
@ -71,7 +71,7 @@ module Cache =
|
||||
let refreshTheme themeId : HttpHandler = requireAccess Administrator >=> fun next ctx -> task {
|
||||
let data = ctx.Data
|
||||
if themeId = "all" then
|
||||
TemplateCache.empty ()
|
||||
Template.Cache.empty ()
|
||||
do! ThemeAssetCache.fill data
|
||||
do! addMessage ctx
|
||||
{ UserMessage.Success with
|
||||
@ -79,7 +79,7 @@ module Cache =
|
||||
else
|
||||
match! data.Theme.FindById(ThemeId themeId) with
|
||||
| Some theme ->
|
||||
TemplateCache.invalidateTheme theme.Id
|
||||
Template.Cache.invalidateTheme theme.Id
|
||||
do! ThemeAssetCache.refreshTheme theme.Id data
|
||||
do! addMessage ctx
|
||||
{ UserMessage.Success with
|
||||
@ -98,7 +98,7 @@ module Category =
|
||||
// GET /admin/categories
|
||||
let all : HttpHandler = fun next ctx ->
|
||||
let response = fun next ctx ->
|
||||
adminPage "Categories" true next ctx (Views.WebLog.categoryList (ctx.Request.Query.ContainsKey "new"))
|
||||
adminPage "Categories" next ctx (Views.WebLog.categoryList (ctx.Request.Query.ContainsKey "new"))
|
||||
(withHxPushUrl (ctx.WebLog.RelativeUrl (Permalink "admin/categories")) >=> response) next ctx
|
||||
|
||||
// GET /admin/category/{id}/edit
|
||||
@ -115,7 +115,7 @@ module Category =
|
||||
| Some (title, cat) ->
|
||||
return!
|
||||
Views.WebLog.categoryEdit (EditCategoryModel.FromCategory cat)
|
||||
|> adminBarePage title true next ctx
|
||||
|> adminBarePage title next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
@ -167,7 +167,7 @@ module RedirectRules =
|
||||
|
||||
// GET /admin/settings/redirect-rules
|
||||
let all : HttpHandler = fun next ctx ->
|
||||
adminPage "Redirect Rules" true next ctx (Views.WebLog.redirectList ctx.WebLog.RedirectRules)
|
||||
adminPage "Redirect Rules" next ctx (Views.WebLog.redirectList ctx.WebLog.RedirectRules)
|
||||
|
||||
// GET /admin/settings/redirect-rules/[index]
|
||||
let edit idx : HttpHandler = fun next ctx ->
|
||||
@ -182,7 +182,7 @@ module RedirectRules =
|
||||
Some
|
||||
("Edit", (Views.WebLog.redirectEdit (EditRedirectRuleModel.FromRule idx (List.item idx rules))))
|
||||
match titleAndView with
|
||||
| Some (title, view) -> adminBarePage $"{title} Redirect Rule" true next ctx view
|
||||
| Some (title, view) -> adminBarePage $"{title} Redirect Rule" next ctx view
|
||||
| None -> Error.notFound next ctx
|
||||
|
||||
/// Update the web log's redirect rules in the database, the request web log, and the web log cache
|
||||
@ -247,7 +247,7 @@ module TagMapping =
|
||||
// GET /admin/settings/tag-mappings
|
||||
let all : HttpHandler = fun next ctx -> task {
|
||||
let! mappings = ctx.Data.TagMap.FindByWebLog ctx.WebLog.Id
|
||||
return! adminBarePage "Tag Mapping List" true next ctx (Views.WebLog.tagMapList mappings)
|
||||
return! adminBarePage "Tag Mapping List" next ctx (Views.WebLog.tagMapList mappings)
|
||||
}
|
||||
|
||||
// GET /admin/settings/tag-mapping/{id}/edit
|
||||
@ -260,7 +260,7 @@ module TagMapping =
|
||||
| Some tm ->
|
||||
return!
|
||||
Views.WebLog.tagMapEdit (EditTagMapModel.FromMapping tm)
|
||||
|> adminBarePage (if isNew then "Add Tag Mapping" else $"Mapping for {tm.Tag} Tag") true next ctx
|
||||
|> adminBarePage (if isNew then "Add Tag Mapping" else $"Mapping for {tm.Tag} Tag") next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
@ -302,12 +302,12 @@ module Theme =
|
||||
let! themes = ctx.Data.Theme.All ()
|
||||
return!
|
||||
Views.Admin.themeList (List.map (DisplayTheme.FromTheme WebLogCache.isThemeInUse) themes)
|
||||
|> adminBarePage "Themes" true next ctx
|
||||
|> adminBarePage "Themes" next ctx
|
||||
}
|
||||
|
||||
// GET /admin/theme/new
|
||||
let add : HttpHandler = requireAccess Administrator >=> fun next ctx ->
|
||||
adminBarePage "Upload a Theme File" true next ctx Views.Admin.themeUpload
|
||||
adminBarePage "Upload a Theme File" next ctx Views.Admin.themeUpload
|
||||
|
||||
/// Update the name and version for a theme based on the version.txt file, if present
|
||||
let private updateNameAndVersion (theme: Theme) (zip: ZipArchive) = backgroundTask {
|
||||
@ -398,7 +398,7 @@ module Theme =
|
||||
do! themeFile.CopyToAsync stream
|
||||
let! _ = loadFromZip themeId stream data
|
||||
do! ThemeAssetCache.refreshTheme themeId data
|
||||
TemplateCache.invalidateTheme themeId
|
||||
Template.Cache.invalidateTheme themeId
|
||||
// Ensure the themes directory exists
|
||||
let themeDir = Path.Combine(".", "themes")
|
||||
if not (Directory.Exists themeDir) then Directory.CreateDirectory themeDir |> ignore
|
||||
@ -464,7 +464,7 @@ module WebLog =
|
||||
return!
|
||||
Views.WebLog.webLogSettings
|
||||
(SettingsModel.FromWebLog ctx.WebLog) themes pages uploads (EditRssModel.FromRssOptions ctx.WebLog.Rss)
|
||||
|> adminPage "Web Log Settings" true next ctx
|
||||
|> adminPage "Web Log Settings" next ctx
|
||||
}
|
||||
|
||||
// POST /admin/settings
|
||||
|
@ -453,7 +453,7 @@ let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next
|
||||
{ Name = string Blog; Value = "Blog" }
|
||||
]
|
||||
Views.WebLog.feedEdit (EditCustomFeedModel.FromFeed f) ratings mediums
|
||||
|> adminPage $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed""" true next ctx
|
||||
|> adminPage $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed""" next ctx
|
||||
| None -> Error.notFound next ctx
|
||||
|
||||
// POST /admin/settings/rss/save
|
||||
|
@ -19,113 +19,9 @@ type ISession with
|
||||
| item -> Some (JsonSerializer.Deserialize<'T> item)
|
||||
|
||||
|
||||
/// Keys used in the myWebLog-standard DotLiquid hash
|
||||
module ViewContext =
|
||||
|
||||
/// The anti cross-site request forgery (CSRF) token set to use for form submissions
|
||||
[<Literal>]
|
||||
let AntiCsrfTokens = "csrf"
|
||||
|
||||
/// The unified application view context
|
||||
[<Literal>]
|
||||
let AppViewContext = "app"
|
||||
|
||||
/// The categories for this web log
|
||||
[<Literal>]
|
||||
let Categories = "categories"
|
||||
|
||||
/// The main content of the view
|
||||
[<Literal>]
|
||||
let Content = "content"
|
||||
|
||||
/// The current page URL
|
||||
[<Literal>]
|
||||
let CurrentPage = "current_page"
|
||||
|
||||
/// The generator string for the current version of myWebLog
|
||||
[<Literal>]
|
||||
let Generator = "generator"
|
||||
|
||||
/// The HTML to load htmx from the unpkg CDN
|
||||
[<Literal>]
|
||||
let HtmxScript = "htmx_script"
|
||||
|
||||
/// Whether the current user has Administrator privileges
|
||||
[<Literal>]
|
||||
let IsAdministrator = "is_administrator"
|
||||
|
||||
/// Whether the current user has Author (or above) privileges
|
||||
[<Literal>]
|
||||
let IsAuthor = "is_author"
|
||||
|
||||
/// Whether the current view is displaying a category archive page
|
||||
[<Literal>]
|
||||
let IsCategory = "is_category"
|
||||
|
||||
/// Whether the current view is displaying the first page of a category archive
|
||||
[<Literal>]
|
||||
let IsCategoryHome = "is_category_home"
|
||||
|
||||
/// Whether the current user has Editor (or above) privileges
|
||||
[<Literal>]
|
||||
let IsEditor = "is_editor"
|
||||
|
||||
/// Whether the current view is the home page for the web log
|
||||
[<Literal>]
|
||||
let IsHome = "is_home"
|
||||
|
||||
/// Whether there is a user logged on
|
||||
[<Literal>]
|
||||
let IsLoggedOn = "is_logged_on"
|
||||
|
||||
/// Whether the current view is displaying a page
|
||||
[<Literal>]
|
||||
let IsPage = "is_page"
|
||||
|
||||
/// Whether the current view is displaying a post
|
||||
[<Literal>]
|
||||
let IsPost = "is_post"
|
||||
|
||||
/// Whether the current view is a tag archive page
|
||||
[<Literal>]
|
||||
let IsTag = "is_tag"
|
||||
|
||||
/// Whether the current view is the first page of a tag archive
|
||||
[<Literal>]
|
||||
let IsTagHome = "is_tag_home"
|
||||
|
||||
/// Whether the current user has Web Log Admin (or above) privileges
|
||||
[<Literal>]
|
||||
let IsWebLogAdmin = "is_web_log_admin"
|
||||
|
||||
/// Messages to be displayed to the user
|
||||
[<Literal>]
|
||||
let Messages = "messages"
|
||||
|
||||
/// The view model / form for the page
|
||||
[<Literal>]
|
||||
let Model = "model"
|
||||
|
||||
/// The listed pages for the web log
|
||||
[<Literal>]
|
||||
let PageList = "page_list"
|
||||
|
||||
/// The title of the page being displayed
|
||||
[<Literal>]
|
||||
let PageTitle = "page_title"
|
||||
|
||||
/// The slug for category or tag archive pages
|
||||
[<Literal>]
|
||||
let Slug = "slug"
|
||||
|
||||
/// The ID of the current user
|
||||
[<Literal>]
|
||||
let UserId = "user_id"
|
||||
|
||||
/// The current web log
|
||||
[<Literal>]
|
||||
let WebLog = "web_log"
|
||||
|
||||
/// Messages to be displayed to the user
|
||||
[<Literal>]
|
||||
let MESSAGES = "messages"
|
||||
|
||||
/// The HTTP item key for loading the session
|
||||
let private sessionLoadedKey = "session-loaded"
|
||||
@ -147,36 +43,25 @@ open MyWebLog.ViewModels
|
||||
/// Add a message to the user's session
|
||||
let addMessage (ctx: HttpContext) message = task {
|
||||
do! loadSession ctx
|
||||
let msg = match ctx.Session.TryGet<UserMessage list> ViewContext.Messages with Some it -> it | None -> []
|
||||
ctx.Session.Set(ViewContext.Messages, message :: msg)
|
||||
let msg = match ctx.Session.TryGet<UserMessage list> MESSAGES with Some it -> it | None -> []
|
||||
ctx.Session.Set(MESSAGES, message :: msg)
|
||||
}
|
||||
|
||||
/// Get any messages from the user's session, removing them in the process
|
||||
let messages (ctx: HttpContext) = task {
|
||||
do! loadSession ctx
|
||||
match ctx.Session.TryGet<UserMessage list> ViewContext.Messages with
|
||||
match ctx.Session.TryGet<UserMessage list> MESSAGES with
|
||||
| Some msg ->
|
||||
ctx.Session.Remove ViewContext.Messages
|
||||
ctx.Session.Remove MESSAGES
|
||||
return msg |> (List.rev >> Array.ofList)
|
||||
| None -> return [||]
|
||||
}
|
||||
|
||||
open MyWebLog
|
||||
open DotLiquid
|
||||
|
||||
/// Shorthand for creating a DotLiquid hash from an anonymous object
|
||||
let makeHash (values: obj) =
|
||||
Hash.FromAnonymousObject values
|
||||
|
||||
/// Create a hash with the page title filled
|
||||
let hashForPage (title: string) =
|
||||
makeHash {| page_title = title |}
|
||||
|
||||
/// Add a key to the hash, returning the modified hash
|
||||
// (note that the hash itself is mutated; this is only used to make it pipeable)
|
||||
let addToHash key (value: obj) (hash: Hash) =
|
||||
if hash.ContainsKey key then hash[key] <- value else hash.Add(key, value)
|
||||
hash
|
||||
/// Create a view context with the page title filled
|
||||
let viewCtxForPage title =
|
||||
{ AppViewContext.Empty with PageTitle = title }
|
||||
|
||||
open System.Security.Claims
|
||||
open Giraffe
|
||||
@ -194,54 +79,31 @@ let private getCurrentMessages ctx = task {
|
||||
}
|
||||
|
||||
/// Generate the view context for a response
|
||||
let private generateViewContext pageTitle messages includeCsrf (ctx: HttpContext) =
|
||||
{ WebLog = ctx.WebLog
|
||||
UserId = ctx.User.Claims
|
||||
|> Seq.tryFind (fun claim -> claim.Type = ClaimTypes.NameIdentifier)
|
||||
|> Option.map (fun claim -> WebLogUserId claim.Value)
|
||||
PageTitle = pageTitle
|
||||
Csrf = if includeCsrf then Some ctx.CsrfTokenSet else None
|
||||
PageList = PageListCache.get ctx
|
||||
Categories = CategoryCache.get ctx
|
||||
CurrentPage = ctx.Request.Path.Value[1..]
|
||||
Messages = messages
|
||||
Generator = ctx.Generator
|
||||
HtmxScript = htmxScript
|
||||
IsAuthor = ctx.HasAccessLevel Author
|
||||
IsEditor = ctx.HasAccessLevel Editor
|
||||
IsWebLogAdmin = ctx.HasAccessLevel WebLogAdmin
|
||||
IsAdministrator = ctx.HasAccessLevel Administrator }
|
||||
let private generateViewContext messages viewCtx (ctx: HttpContext) =
|
||||
{ viewCtx with
|
||||
WebLog = ctx.WebLog
|
||||
UserId = ctx.User.Claims
|
||||
|> Seq.tryFind (fun claim -> claim.Type = ClaimTypes.NameIdentifier)
|
||||
|> Option.map (fun claim -> WebLogUserId claim.Value)
|
||||
Csrf = Some ctx.CsrfTokenSet
|
||||
PageList = PageListCache.get ctx
|
||||
Categories = CategoryCache.get ctx
|
||||
CurrentPage = ctx.Request.Path.Value[1..]
|
||||
Messages = messages
|
||||
Generator = ctx.Generator
|
||||
HtmxScript = htmxScript
|
||||
IsAuthor = ctx.HasAccessLevel Author
|
||||
IsEditor = ctx.HasAccessLevel Editor
|
||||
IsWebLogAdmin = ctx.HasAccessLevel WebLogAdmin
|
||||
IsAdministrator = ctx.HasAccessLevel Administrator }
|
||||
|
||||
|
||||
/// Populate the DotLiquid hash with standard information
|
||||
let addViewContext ctx (hash: Hash) = task {
|
||||
/// Update the view context with standard information (if it has not been done yet) or updated messages
|
||||
let updateViewContext ctx viewCtx = task {
|
||||
let! messages = getCurrentMessages ctx
|
||||
if hash.ContainsKey ViewContext.AppViewContext then
|
||||
let oldApp = hash[ViewContext.AppViewContext] :?> AppViewContext
|
||||
let newApp = { oldApp with Messages = Array.concat [ oldApp.Messages; messages ] }
|
||||
return
|
||||
hash
|
||||
|> addToHash ViewContext.AppViewContext newApp
|
||||
|> addToHash ViewContext.Messages newApp.Messages
|
||||
if viewCtx.Generator = "" then
|
||||
return generateViewContext messages viewCtx ctx
|
||||
else
|
||||
let app =
|
||||
generateViewContext (string hash[ViewContext.PageTitle]) messages
|
||||
(hash.ContainsKey ViewContext.AntiCsrfTokens) ctx
|
||||
return
|
||||
hash
|
||||
|> addToHash ViewContext.UserId (app.UserId |> Option.map string |> Option.defaultValue "")
|
||||
|> addToHash ViewContext.WebLog app.WebLog
|
||||
|> addToHash ViewContext.PageList app.PageList
|
||||
|> addToHash ViewContext.Categories app.Categories
|
||||
|> addToHash ViewContext.CurrentPage app.CurrentPage
|
||||
|> addToHash ViewContext.Messages app.Messages
|
||||
|> addToHash ViewContext.Generator app.Generator
|
||||
|> addToHash ViewContext.HtmxScript app.HtmxScript
|
||||
|> addToHash ViewContext.IsLoggedOn app.IsLoggedOn
|
||||
|> addToHash ViewContext.IsAuthor app.IsAuthor
|
||||
|> addToHash ViewContext.IsEditor app.IsEditor
|
||||
|> addToHash ViewContext.IsWebLogAdmin app.IsWebLogAdmin
|
||||
|> addToHash ViewContext.IsAdministrator app.IsAdministrator
|
||||
return { viewCtx with Messages = Array.concat [ viewCtx.Messages; messages ] }
|
||||
}
|
||||
|
||||
/// Is the request from htmx?
|
||||
@ -269,6 +131,7 @@ let redirectToGet url : HttpHandler = fun _ ctx -> task {
|
||||
}
|
||||
|
||||
/// The MIME type for podcast episode JSON chapters
|
||||
[<Literal>]
|
||||
let JSON_CHAPTERS = "application/json+chapters"
|
||||
|
||||
|
||||
@ -311,65 +174,65 @@ module Error =
|
||||
else ServerErrors.INTERNAL_ERROR message earlyReturn ctx)
|
||||
|
||||
|
||||
/// Render a view for the specified theme, using the specified template, layout, and hash
|
||||
let viewForTheme themeId template next ctx (hash: Hash) = task {
|
||||
let! hash = addViewContext ctx hash
|
||||
/// Render a view for the specified theme, using the specified template, layout, and context
|
||||
let viewForTheme themeId template next ctx (viewCtx: AppViewContext) = task {
|
||||
let! updated = updateViewContext ctx viewCtx
|
||||
|
||||
// NOTE: DotLiquid does not support {% render %} or {% include %} in its templates, so we will do a 2-pass render;
|
||||
// the net effect is a "layout" capability similar to Razor or Pug
|
||||
// NOTE: Although Fluid's view engine support implements layouts and sections, it also relies on the filesystem.
|
||||
// As we are loading templates from memory or a database, we do a 2-pass render; the first for the content,
|
||||
// the second for the overall page.
|
||||
|
||||
// Render view content...
|
||||
match! TemplateCache.get themeId template ctx.Data with
|
||||
match! Template.Cache.get themeId template ctx.Data with
|
||||
| Ok contentTemplate ->
|
||||
let _ = addToHash ViewContext.Content (contentTemplate.Render hash) hash
|
||||
let forLayout = { updated with Content = Template.render contentTemplate updated ctx.Data }
|
||||
// ...then render that content with its layout
|
||||
match! TemplateCache.get themeId (if isHtmx ctx then "layout-partial" else "layout") ctx.Data with
|
||||
| Ok layoutTemplate -> return! htmlString (layoutTemplate.Render hash) next ctx
|
||||
match! Template.Cache.get themeId (if isHtmx ctx then "layout-partial" else "layout") ctx.Data with
|
||||
| Ok layoutTemplate -> return! htmlString (Template.render layoutTemplate forLayout ctx.Data) next ctx
|
||||
| Error message -> return! Error.server message next ctx
|
||||
| Error message -> return! Error.server message next ctx
|
||||
}
|
||||
|
||||
/// Render a bare view for the specified theme, using the specified template and hash
|
||||
let bareForTheme themeId template next ctx (hash: Hash) = task {
|
||||
let! hash = addViewContext ctx hash
|
||||
/// Render a bare view for the specified theme, using the specified template and context
|
||||
let bareForTheme themeId template next ctx viewCtx = task {
|
||||
let! updated = updateViewContext ctx viewCtx
|
||||
let withContent = task {
|
||||
if hash.ContainsKey ViewContext.Content then return Ok hash
|
||||
if updated.Content = "" then
|
||||
match! Template.Cache.get themeId template ctx.Data with
|
||||
| Ok contentTemplate -> return Ok { updated with Content = Template.render contentTemplate updated ctx.Data }
|
||||
| Error message -> return Error message
|
||||
else
|
||||
match! TemplateCache.get themeId template ctx.Data with
|
||||
| Ok contentTemplate -> return Ok(addToHash ViewContext.Content (contentTemplate.Render hash) hash)
|
||||
| Error message -> return Error message
|
||||
return Ok viewCtx
|
||||
}
|
||||
match! withContent with
|
||||
| Ok completeHash ->
|
||||
| Ok completeCtx ->
|
||||
// Bare templates are rendered with layout-bare
|
||||
match! TemplateCache.get themeId "layout-bare" ctx.Data with
|
||||
match! Template.Cache.get themeId "layout-bare" ctx.Data with
|
||||
| Ok layoutTemplate ->
|
||||
return!
|
||||
(messagesToHeaders (hash[ViewContext.Messages] :?> UserMessage array)
|
||||
>=> htmlString (layoutTemplate.Render completeHash))
|
||||
(messagesToHeaders completeCtx.Messages >=> htmlString (Template.render layoutTemplate completeCtx ctx.Data))
|
||||
next ctx
|
||||
| Error message -> return! Error.server message next ctx
|
||||
| Error message -> return! Error.server message next ctx
|
||||
}
|
||||
|
||||
/// Return a view for the web log's default theme
|
||||
let themedView template next ctx hash = task {
|
||||
let! hash = addViewContext ctx hash
|
||||
return! viewForTheme (hash[ViewContext.WebLog] :?> WebLog).ThemeId template next ctx hash
|
||||
let themedView template next (ctx: HttpContext) viewCtx = task {
|
||||
return! viewForTheme ctx.WebLog.ThemeId template next ctx viewCtx
|
||||
}
|
||||
|
||||
/// Display a page for an admin endpoint
|
||||
let adminPage pageTitle includeCsrf next ctx (content: AppViewContext -> XmlNode list) = task {
|
||||
let adminPage pageTitle next ctx (content: AppViewContext -> XmlNode list) = task {
|
||||
let! messages = getCurrentMessages ctx
|
||||
let appCtx = generateViewContext pageTitle messages includeCsrf ctx
|
||||
let appCtx = generateViewContext messages (viewCtxForPage pageTitle) ctx
|
||||
let layout = if isHtmx ctx then Layout.partial else Layout.full
|
||||
return! htmlString (layout content appCtx |> RenderView.AsString.htmlDocument) next ctx
|
||||
}
|
||||
|
||||
/// Display a bare page for an admin endpoint
|
||||
let adminBarePage pageTitle includeCsrf next ctx (content: AppViewContext -> XmlNode list) = task {
|
||||
let adminBarePage pageTitle next ctx (content: AppViewContext -> XmlNode list) = task {
|
||||
let! messages = getCurrentMessages ctx
|
||||
let appCtx = generateViewContext pageTitle messages includeCsrf ctx
|
||||
let appCtx = generateViewContext messages (viewCtxForPage pageTitle) ctx
|
||||
return!
|
||||
( messagesToHeaders appCtx.Messages
|
||||
>=> htmlString (Layout.bare content appCtx |> RenderView.AsString.htmlDocument)) next ctx
|
||||
|
@ -17,7 +17,7 @@ let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|
||||
|> List.ofSeq
|
||||
return!
|
||||
Views.Page.pageList displayPages pageNbr (pages.Length > 25)
|
||||
|> adminPage "Pages" true next ctx
|
||||
|> adminPage "Pages" next ctx
|
||||
}
|
||||
|
||||
// GET /admin/page/{id}/edit
|
||||
@ -34,7 +34,7 @@ let edit pgId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|
||||
| Some (title, page) when canEdit page.AuthorId ctx ->
|
||||
let model = EditPageModel.FromPage page
|
||||
let! templates = templatesForTheme ctx "page"
|
||||
return! adminPage title true next ctx (Views.Page.pageEdit model templates)
|
||||
return! adminPage title next ctx (Views.Page.pageEdit model templates)
|
||||
| Some _ -> return! Error.notAuthorized next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
@ -56,7 +56,7 @@ let editPermalinks pgId : HttpHandler = requireAccess Author >=> fun next ctx ->
|
||||
return!
|
||||
ManagePermalinksModel.FromPage pg
|
||||
|> Views.Helpers.managePermalinks
|
||||
|> adminPage "Manage Prior Permalinks" true next ctx
|
||||
|> adminPage "Manage Prior Permalinks" next ctx
|
||||
| Some _ -> return! Error.notAuthorized next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
@ -84,7 +84,7 @@ let editRevisions pgId : HttpHandler = requireAccess Author >=> fun next ctx ->
|
||||
return!
|
||||
ManageRevisionsModel.FromPage pg
|
||||
|> Views.Helpers.manageRevisions
|
||||
|> adminPage "Manage Page Revisions" true next ctx
|
||||
|> adminPage "Manage Page Revisions" next ctx
|
||||
| Some _ -> return! Error.notAuthorized next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
@ -115,7 +115,7 @@ let private findPageRevision pgId revDate (ctx: HttpContext) = task {
|
||||
let previewRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|
||||
match! findPageRevision pgId revDate ctx with
|
||||
| Some pg, Some rev when canEdit pg.AuthorId ctx ->
|
||||
return! adminBarePage "" false next ctx (Views.Helpers.commonPreview rev)
|
||||
return! adminBarePage "" next ctx (Views.Helpers.commonPreview rev)
|
||||
| Some _, Some _ -> return! Error.notAuthorized next ctx
|
||||
| None, _ | _, None -> return! Error.notFound next ctx
|
||||
}
|
||||
@ -141,7 +141,7 @@ let deleteRevision (pgId, revDate) : HttpHandler = requireAccess Author >=> fun
|
||||
| Some pg, Some rev when canEdit pg.AuthorId ctx ->
|
||||
do! ctx.Data.Page.Update { pg with Revisions = pg.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf) }
|
||||
do! addMessage ctx { UserMessage.Success with Message = "Revision deleted successfully" }
|
||||
return! adminBarePage "" false next ctx (fun _ -> [])
|
||||
return! adminBarePage "" next ctx (fun _ -> [])
|
||||
| Some _, Some _ -> return! Error.notAuthorized next ctx
|
||||
| None, _
|
||||
| _, None -> return! Error.notFound next ctx
|
||||
|
@ -4,6 +4,7 @@ module MyWebLog.Handlers.Post
|
||||
open System
|
||||
open System.Collections.Generic
|
||||
open MyWebLog
|
||||
open MyWebLog.Views
|
||||
|
||||
/// Parse a slug and page number from an "everything else" URL
|
||||
let private parseSlugAndPage webLog (slugAndPage: string seq) =
|
||||
@ -87,30 +88,29 @@ let preparePostList webLog posts listType (url: string) pageNbr perPage (data: I
|
||||
OlderName = olderPost |> Option.map _.Title
|
||||
}
|
||||
return
|
||||
makeHash {||}
|
||||
|> addToHash ViewContext.Model model
|
||||
|> addToHash "tag_mappings" tagMappings
|
||||
|> addToHash ViewContext.IsPost (match listType with SinglePost -> true | _ -> false)
|
||||
{ AppViewContext.Empty with
|
||||
Payload = model
|
||||
TagMappings = Array.ofList tagMappings
|
||||
IsPost = (match listType with SinglePost -> true | _ -> false) }
|
||||
}
|
||||
|
||||
open Giraffe
|
||||
|
||||
// GET /page/{pageNbr}
|
||||
let pageOfPosts pageNbr : HttpHandler = fun next ctx -> task {
|
||||
let count = ctx.WebLog.PostsPerPage
|
||||
let data = ctx.Data
|
||||
let! posts = data.Post.FindPageOfPublishedPosts ctx.WebLog.Id pageNbr count
|
||||
let! hash = preparePostList ctx.WebLog posts PostList "" pageNbr count data
|
||||
let title =
|
||||
let count = ctx.WebLog.PostsPerPage
|
||||
let data = ctx.Data
|
||||
let! posts = data.Post.FindPageOfPublishedPosts ctx.WebLog.Id pageNbr count
|
||||
let! viewCtx = preparePostList ctx.WebLog posts PostList "" pageNbr count data
|
||||
let title =
|
||||
match pageNbr, ctx.WebLog.DefaultPage with
|
||||
| 1, "posts" -> None
|
||||
| _, "posts" -> Some $"Page {pageNbr}"
|
||||
| _, _ -> Some $"Page {pageNbr} « Posts"
|
||||
return!
|
||||
match title with Some ttl -> addToHash ViewContext.PageTitle ttl hash | None -> hash
|
||||
|> function
|
||||
| hash ->
|
||||
if pageNbr = 1 && ctx.WebLog.DefaultPage = "posts" then addToHash ViewContext.IsHome true hash else hash
|
||||
{ viewCtx with
|
||||
PageTitle = defaultArg title viewCtx.PageTitle
|
||||
IsHome = pageNbr = 1 && ctx.WebLog.DefaultPage = "posts" }
|
||||
|> themedView "index" next ctx
|
||||
}
|
||||
|
||||
@ -134,14 +134,15 @@ let pageOfCategorizedPosts slugAndPage : HttpHandler = fun next ctx -> task {
|
||||
match! data.Post.FindPageOfCategorizedPosts webLog.Id (getCategoryIds slug ctx) pageNbr webLog.PostsPerPage
|
||||
with
|
||||
| posts when List.length posts > 0 ->
|
||||
let! hash = preparePostList webLog posts CategoryList cat.Slug pageNbr webLog.PostsPerPage data
|
||||
let! viewCtx = preparePostList webLog posts CategoryList cat.Slug pageNbr webLog.PostsPerPage data
|
||||
let pgTitle = if pageNbr = 1 then "" else $""" <small class="archive-pg-nbr">(Page {pageNbr})</small>"""
|
||||
return!
|
||||
addToHash ViewContext.PageTitle $"{cat.Name}: Category Archive{pgTitle}" hash
|
||||
|> addToHash "subtitle" (defaultArg cat.Description "")
|
||||
|> addToHash ViewContext.IsCategory true
|
||||
|> addToHash ViewContext.IsCategoryHome (pageNbr = 1)
|
||||
|> addToHash ViewContext.Slug slug
|
||||
{ viewCtx with
|
||||
PageTitle = $"{cat.Name}: Category Archive{pgTitle}"
|
||||
Subtitle = cat.Description
|
||||
IsCategory = true
|
||||
IsCategoryHome = (pageNbr = 1)
|
||||
Slug = Some slug }
|
||||
|> themedView "index" next ctx
|
||||
| _ -> return! Error.notFound next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
@ -169,13 +170,14 @@ let pageOfTaggedPosts slugAndPage : HttpHandler = fun next ctx -> task {
|
||||
else
|
||||
match! data.Post.FindPageOfTaggedPosts webLog.Id tag pageNbr webLog.PostsPerPage with
|
||||
| posts when List.length posts > 0 ->
|
||||
let! hash = preparePostList webLog posts TagList rawTag pageNbr webLog.PostsPerPage data
|
||||
let pgTitle = if pageNbr = 1 then "" else $""" <small class="archive-pg-nbr">(Page {pageNbr})</small>"""
|
||||
let! viewCtx = preparePostList webLog posts TagList rawTag pageNbr webLog.PostsPerPage data
|
||||
let pgTitle = if pageNbr = 1 then "" else $" <small class=\"archive-pg-nbr\">(Page {pageNbr})</small>"
|
||||
return!
|
||||
addToHash ViewContext.PageTitle $"Posts Tagged “{tag}”{pgTitle}" hash
|
||||
|> addToHash ViewContext.IsTag true
|
||||
|> addToHash ViewContext.IsTagHome (pageNbr = 1)
|
||||
|> addToHash ViewContext.Slug rawTag
|
||||
{ viewCtx with
|
||||
PageTitle = $"Posts Tagged “{tag}”{pgTitle}"
|
||||
IsTag = true
|
||||
IsTagHome = (pageNbr = 1)
|
||||
Slug = Some rawTag }
|
||||
|> themedView "index" next ctx
|
||||
// Other systems use hyphens for spaces; redirect if this is an old tag link
|
||||
| _ ->
|
||||
@ -200,9 +202,9 @@ let home : HttpHandler = fun next ctx -> task {
|
||||
match! ctx.Data.Page.FindById (PageId pageId) webLog.Id with
|
||||
| Some page ->
|
||||
return!
|
||||
hashForPage page.Title
|
||||
|> addToHash "page" (DisplayPage.FromPage webLog page)
|
||||
|> addToHash ViewContext.IsHome true
|
||||
{ viewCtxForPage page.Title with
|
||||
Payload = DisplayPage.FromPage webLog page
|
||||
IsHome = true }
|
||||
|> themedView (defaultArg page.Template "single-page") next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
@ -251,10 +253,10 @@ let chapters (post: Post) : HttpHandler = fun next ctx ->
|
||||
// GET /admin/posts
|
||||
// GET /admin/posts/page/{pageNbr}
|
||||
let all pageNbr : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|
||||
let data = ctx.Data
|
||||
let! posts = data.Post.FindPageOfPosts ctx.WebLog.Id pageNbr 25
|
||||
let! hash = preparePostList ctx.WebLog posts AdminList "" pageNbr 25 data
|
||||
return! adminPage "Posts" true next ctx (Views.Post.list (hash[ViewContext.Model] :?> PostDisplay))
|
||||
let data = ctx.Data
|
||||
let! posts = data.Post.FindPageOfPosts ctx.WebLog.Id pageNbr 25
|
||||
let! viewCtx = preparePostList ctx.WebLog posts AdminList "" pageNbr 25 data
|
||||
return! adminPage "Posts" next ctx (Post.list viewCtx.Posts)
|
||||
}
|
||||
|
||||
// GET /admin/post/{id}/edit
|
||||
@ -278,7 +280,7 @@ let edit postId : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|
||||
{ Name = string No; Value = "No" }
|
||||
{ Name = string Clean; Value = "Clean" }
|
||||
]
|
||||
return! adminPage title true next ctx (Views.Post.postEdit model templates ratings)
|
||||
return! adminPage title next ctx (Post.postEdit model templates ratings)
|
||||
| Some _ -> return! Error.notAuthorized next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
@ -298,8 +300,8 @@ let editPermalinks postId : HttpHandler = requireAccess Author >=> fun next ctx
|
||||
| Some post when canEdit post.AuthorId ctx ->
|
||||
return!
|
||||
ManagePermalinksModel.FromPost post
|
||||
|> Views.Helpers.managePermalinks
|
||||
|> adminPage "Manage Prior Permalinks" true next ctx
|
||||
|> managePermalinks
|
||||
|> adminPage "Manage Prior Permalinks" next ctx
|
||||
| Some _ -> return! Error.notAuthorized next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
@ -326,8 +328,8 @@ let editRevisions postId : HttpHandler = requireAccess Author >=> fun next ctx -
|
||||
| Some post when canEdit post.AuthorId ctx ->
|
||||
return!
|
||||
ManageRevisionsModel.FromPost post
|
||||
|> Views.Helpers.manageRevisions
|
||||
|> adminPage "Manage Post Revisions" true next ctx
|
||||
|> manageRevisions
|
||||
|> adminPage "Manage Post Revisions" next ctx
|
||||
| Some _ -> return! Error.notAuthorized next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
@ -359,7 +361,7 @@ let private findPostRevision postId revDate (ctx: HttpContext) = task {
|
||||
let previewRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|
||||
match! findPostRevision postId revDate ctx with
|
||||
| Some post, Some rev when canEdit post.AuthorId ctx ->
|
||||
return! adminBarePage "" false next ctx (Views.Helpers.commonPreview rev)
|
||||
return! adminBarePage "" next ctx (commonPreview rev)
|
||||
| Some _, Some _ -> return! Error.notAuthorized next ctx
|
||||
| None, _ | _, None -> return! Error.notFound next ctx
|
||||
}
|
||||
@ -385,7 +387,7 @@ let deleteRevision (postId, revDate) : HttpHandler = requireAccess Author >=> fu
|
||||
| Some post, Some rev when canEdit post.AuthorId ctx ->
|
||||
do! ctx.Data.Post.Update { post with Revisions = post.Revisions |> List.filter (fun r -> r.AsOf <> rev.AsOf) }
|
||||
do! addMessage ctx { UserMessage.Success with Message = "Revision deleted successfully" }
|
||||
return! adminBarePage "" false next ctx (fun _ -> [])
|
||||
return! adminBarePage "" next ctx (fun _ -> [])
|
||||
| Some _, Some _ -> return! Error.notAuthorized next ctx
|
||||
| None, _
|
||||
| _, None -> return! Error.notFound next ctx
|
||||
@ -399,8 +401,8 @@ let manageChapters postId : HttpHandler = requireAccess Author >=> fun next ctx
|
||||
&& Option.isSome post.Episode.Value.Chapters
|
||||
&& canEdit post.AuthorId ctx ->
|
||||
return!
|
||||
Views.Post.chapters false (ManageChaptersModel.Create post)
|
||||
|> adminPage "Manage Chapters" true next ctx
|
||||
Post.chapters false (ManageChaptersModel.Create post)
|
||||
|> adminPage "Manage Chapters" next ctx
|
||||
| Some _ | None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
@ -419,8 +421,8 @@ let editChapter (postId, index) : HttpHandler = requireAccess Author >=> fun nex
|
||||
match chapter with
|
||||
| Some chap ->
|
||||
return!
|
||||
Views.Post.chapterEdit (EditChapterModel.FromChapter post.Id index chap)
|
||||
|> adminBarePage (if index = -1 then "Add a Chapter" else "Edit Chapter") true next ctx
|
||||
Post.chapterEdit (EditChapterModel.FromChapter post.Id index chap)
|
||||
|> adminBarePage (if index = -1 then "Add a Chapter" else "Edit Chapter") next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
| Some _ | None -> return! Error.notFound next ctx
|
||||
}
|
||||
@ -447,8 +449,8 @@ let saveChapter (postId, index) : HttpHandler = requireAccess Author >=> fun nex
|
||||
do! data.Post.Update updatedPost
|
||||
do! addMessage ctx { UserMessage.Success with Message = "Chapter saved successfully" }
|
||||
return!
|
||||
Views.Post.chapterList form.AddAnother (ManageChaptersModel.Create updatedPost)
|
||||
|> adminBarePage "Manage Chapters" true next ctx
|
||||
Post.chapterList form.AddAnother (ManageChaptersModel.Create updatedPost)
|
||||
|> adminBarePage "Manage Chapters" next ctx
|
||||
with
|
||||
| ex -> return! Error.server ex.Message next ctx
|
||||
else return! Error.notFound next ctx
|
||||
@ -471,8 +473,8 @@ let deleteChapter (postId, index) : HttpHandler = requireAccess Author >=> fun n
|
||||
do! data.Post.Update updatedPost
|
||||
do! addMessage ctx { UserMessage.Success with Message = "Chapter deleted successfully" }
|
||||
return!
|
||||
Views.Post.chapterList false (ManageChaptersModel.Create updatedPost)
|
||||
|> adminPage "Manage Chapters" true next ctx
|
||||
Post.chapterList false (ManageChaptersModel.Create updatedPost)
|
||||
|> adminPage "Manage Chapters" next ctx
|
||||
else return! Error.notFound next ctx
|
||||
| Some _ | None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
@ -34,9 +34,8 @@ module CatchAll =
|
||||
yield Post.chapters post
|
||||
else
|
||||
yield fun next ctx ->
|
||||
Post.preparePostList webLog [ post ] Post.ListType.SinglePost "" 1 1 data
|
||||
|> await
|
||||
|> addToHash ViewContext.PageTitle post.Title
|
||||
{ await (Post.preparePostList webLog [ post ] Post.ListType.SinglePost "" 1 1 data) with
|
||||
PageTitle = post.Title }
|
||||
|> themedView (defaultArg post.Template "single-post") next ctx
|
||||
| None -> ()
|
||||
// Current page
|
||||
@ -44,9 +43,9 @@ module CatchAll =
|
||||
| Some page ->
|
||||
debug (fun () -> "Found page by permalink")
|
||||
yield fun next ctx ->
|
||||
hashForPage page.Title
|
||||
|> addToHash "page" (DisplayPage.FromPage webLog page)
|
||||
|> addToHash ViewContext.IsPage true
|
||||
{ viewCtxForPage page.Title with
|
||||
Payload = DisplayPage.FromPage webLog page
|
||||
IsPage = true }
|
||||
|> themedView (defaultArg page.Template "single-page") next ctx
|
||||
| None -> ()
|
||||
// RSS feed
|
||||
|
@ -120,12 +120,12 @@ let list : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|
||||
|> Seq.append diskUploads
|
||||
|> Seq.sortByDescending (fun file -> file.UpdatedOn, file.Path)
|
||||
|> Views.WebLog.uploadList
|
||||
|> adminPage "Uploaded Files" true next ctx
|
||||
|> adminPage "Uploaded Files" next ctx
|
||||
}
|
||||
|
||||
// GET /admin/upload/new
|
||||
let showNew : HttpHandler = requireAccess Author >=> fun next ctx ->
|
||||
adminPage "Upload a File" true next ctx Views.WebLog.uploadNew
|
||||
adminPage "Upload a File" next ctx Views.WebLog.uploadNew
|
||||
|
||||
// POST /admin/upload/save
|
||||
let save : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|
||||
|
@ -35,7 +35,7 @@ let logOn returnUrl : HttpHandler = fun next ctx ->
|
||||
match returnUrl with
|
||||
| Some _ -> returnUrl
|
||||
| None -> if ctx.Request.Query.ContainsKey "returnUrl" then Some ctx.Request.Query["returnUrl"].[0] else None
|
||||
adminPage "Log On" true next ctx (Views.User.logOn { LogOnModel.Empty with ReturnTo = returnTo })
|
||||
adminPage "Log On" next ctx (Views.User.logOn { LogOnModel.Empty with ReturnTo = returnTo })
|
||||
|
||||
|
||||
open System.Security.Claims
|
||||
@ -91,12 +91,12 @@ let private goAway : HttpHandler = RequestErrors.BAD_REQUEST "really?"
|
||||
// GET /admin/settings/users
|
||||
let all : HttpHandler = fun next ctx -> task {
|
||||
let! users = ctx.Data.WebLogUser.FindByWebLog ctx.WebLog.Id
|
||||
return! adminBarePage "User Administration" true next ctx (Views.User.userList users)
|
||||
return! adminBarePage "User Administration" next ctx (Views.User.userList users)
|
||||
}
|
||||
|
||||
/// Show the edit user page
|
||||
let private showEdit (model: EditUserModel) : HttpHandler = fun next ctx ->
|
||||
adminBarePage (if model.IsNew then "Add a New User" else "Edit User") true next ctx (Views.User.edit model)
|
||||
adminBarePage (if model.IsNew then "Add a New User" else "Edit User") next ctx (Views.User.edit model)
|
||||
|
||||
// GET /admin/settings/user/{id}/edit
|
||||
let edit usrId : HttpHandler = fun next ctx -> task {
|
||||
@ -139,7 +139,7 @@ let myInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|
||||
| Some user ->
|
||||
return!
|
||||
Views.User.myInfo (EditMyInfoModel.FromUser user) user
|
||||
|> adminPage "Edit Your Information" true next ctx
|
||||
|> adminPage "Edit Your Information" next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
@ -164,7 +164,7 @@ let saveMyInfo : HttpHandler = requireAccess Author >=> fun next ctx -> task {
|
||||
do! addMessage ctx { UserMessage.Error with Message = "Passwords did not match; no updates made" }
|
||||
return!
|
||||
Views.User.myInfo { model with NewPassword = ""; NewPasswordConfirm = "" } user
|
||||
|> adminPage "Edit Your Information" true next ctx
|
||||
|> adminPage "Edit Your Information" next ctx
|
||||
| None -> return! Error.notFound next ctx
|
||||
}
|
||||
|
||||
|
@ -9,6 +9,8 @@
|
||||
<ItemGroup>
|
||||
<Content Include="appsettings*.json" CopyToOutputDirectory="Always" />
|
||||
<Compile Include="Caches.fs" />
|
||||
<Compile Include="ViewContext.fs" />
|
||||
<Compile Include="Template.fs" />
|
||||
<Compile Include="Views\Helpers.fs" />
|
||||
<Compile Include="Views\Admin.fs" />
|
||||
<Compile Include="Views\Page.fs" />
|
||||
@ -31,13 +33,14 @@
|
||||
<ItemGroup>
|
||||
<PackageReference Include="BitBadger.AspNetCore.CanonicalDomains" Version="1.0.0" />
|
||||
<PackageReference Include="DotLiquid" Version="2.2.692" />
|
||||
<PackageReference Include="Fluid.Core" Version="2.11.1" />
|
||||
<PackageReference Include="Giraffe" Version="6.4.0" />
|
||||
<PackageReference Include="Giraffe.Htmx" Version="2.0.0" />
|
||||
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="2.0.0" />
|
||||
<PackageReference Include="Giraffe.Htmx" Version="2.0.2" />
|
||||
<PackageReference Include="Giraffe.ViewEngine.Htmx" Version="2.0.2" />
|
||||
<PackageReference Include="NeoSmart.Caching.Sqlite.AspNetCore" Version="8.0.0" />
|
||||
<PackageReference Include="RethinkDB.DistributedCache" Version="1.0.0-rc1" />
|
||||
<PackageReference Include="System.ServiceModel.Syndication" Version="8.0.0" />
|
||||
<PackageReference Update="FSharp.Core" Version="8.0.300" />
|
||||
<PackageReference Update="FSharp.Core" Version="8.0.400" />
|
||||
</ItemGroup>
|
||||
|
||||
<ItemGroup>
|
||||
|
@ -27,7 +27,7 @@ type WebLogMiddleware(next: RequestDelegate, log: ILogger<WebLogMiddleware>) =
|
||||
|
||||
|
||||
/// Middleware to check redirects for the current web log
|
||||
type RedirectRuleMiddleware(next: RequestDelegate, log: ILogger<RedirectRuleMiddleware>) =
|
||||
type RedirectRuleMiddleware(next: RequestDelegate, _log: ILogger<RedirectRuleMiddleware>) =
|
||||
|
||||
/// Shorthand for case-insensitive string equality
|
||||
let ciEquals str1 str2 =
|
||||
|
334
src/MyWebLog/Template.fs
Normal file
334
src/MyWebLog/Template.fs
Normal file
@ -0,0 +1,334 @@
|
||||
module MyWebLog.Template
|
||||
|
||||
open System
|
||||
open System.Collections.Generic
|
||||
open System.IO
|
||||
open System.Text
|
||||
open Fluid
|
||||
open Fluid.Values
|
||||
open Giraffe.ViewEngine
|
||||
open Microsoft.AspNetCore.Antiforgery
|
||||
open Microsoft.Extensions.FileProviders
|
||||
open MyWebLog
|
||||
open MyWebLog.ViewModels
|
||||
|
||||
/// Alias for ValueTask
|
||||
type VTask<'T> = System.Threading.Tasks.ValueTask<'T>
|
||||
|
||||
|
||||
/// Extensions on Fluid's TemplateContext object
|
||||
type TemplateContext with
|
||||
|
||||
/// Get the model of the context as an AppViewContext instance
|
||||
member this.App =
|
||||
this.Model.ToObjectValue() :?> AppViewContext
|
||||
|
||||
|
||||
/// Helper functions for filters and tags
|
||||
[<AutoOpen>]
|
||||
module private Helpers =
|
||||
|
||||
/// Does an asset exist for the current theme?
|
||||
let assetExists fileName (webLog: WebLog) =
|
||||
ThemeAssetCache.get webLog.ThemeId |> List.exists (fun it -> it = fileName)
|
||||
|
||||
/// Obtain the link from known types
|
||||
let permalink (item: FluidValue) (linkFunc: Permalink -> string) =
|
||||
match item.Type with
|
||||
| FluidValues.String -> Some (item.ToStringValue())
|
||||
| FluidValues.Object ->
|
||||
match item.ToObjectValue() with
|
||||
| :? DisplayPage as page -> Some page.Permalink
|
||||
| :? PostListItem as post -> Some post.Permalink
|
||||
| :? Permalink as link -> Some (string link)
|
||||
| _ -> None
|
||||
| _ -> None
|
||||
|> function
|
||||
| Some link -> linkFunc (Permalink link)
|
||||
| None -> $"alert('unknown item type {item.Type}')"
|
||||
|
||||
/// Generate a link for theme asset (image, stylesheet, script, etc.)
|
||||
let themeAsset (input: FluidValue) (ctx: TemplateContext) =
|
||||
let app = ctx.App
|
||||
app.WebLog.RelativeUrl(Permalink $"themes/{app.WebLog.ThemeId}/{input.ToStringValue()}")
|
||||
|
||||
|
||||
/// Fluid template options customized with myWebLog filters
|
||||
let options () =
|
||||
let sValue = StringValue >> VTask<FluidValue>
|
||||
|
||||
let it = TemplateOptions.Default
|
||||
it.MemberAccessStrategy.MemberNameStrategy <- MemberNameStrategies.SnakeCase
|
||||
[ // Domain types
|
||||
typeof<CustomFeed>; typeof<Episode>; typeof<Episode option>; typeof<MetaItem>; typeof<Page>; typeof<RssOptions>
|
||||
typeof<TagMap>; typeof<WebLog>
|
||||
// View models
|
||||
typeof<AppViewContext>; typeof<DisplayCategory>; typeof<DisplayPage>; typeof<EditPageModel>; typeof<PostDisplay>
|
||||
typeof<PostListItem>; typeof<UserMessage>
|
||||
// Framework types
|
||||
typeof<AntiforgeryTokenSet>; typeof<DateTime option>; typeof<int option>; typeof<KeyValuePair>
|
||||
typeof<MetaItem list>; typeof<string list>; typeof<string option>; typeof<TagMap list> ]
|
||||
|> List.iter it.MemberAccessStrategy.Register
|
||||
|
||||
// A filter to generate an absolute link
|
||||
it.Filters.AddFilter("absolute_link", fun input _ ctx -> sValue (permalink input ctx.App.WebLog.AbsoluteUrl))
|
||||
|
||||
// A filter to generate a link with posts categorized under the given category
|
||||
it.Filters.AddFilter("category_link",
|
||||
fun input _ ctx ->
|
||||
match input.ToObjectValue() with
|
||||
| :? DisplayCategory as cat -> Some cat.Slug
|
||||
| :? string as slug -> Some slug
|
||||
| _ -> None
|
||||
|> function
|
||||
| Some slug -> ctx.App.WebLog.RelativeUrl(Permalink $"category/{slug}/")
|
||||
| None -> $"alert('unknown category object type {input.Type}')"
|
||||
|> sValue)
|
||||
|
||||
// A filter to generate a link that will edit a page
|
||||
it.Filters.AddFilter("edit_page_link",
|
||||
fun input _ ctx ->
|
||||
match input.ToObjectValue() with
|
||||
| :? DisplayPage as page -> Some page.Id
|
||||
| :? string as theId -> Some theId
|
||||
| _ -> None
|
||||
|> function
|
||||
| Some pageId -> ctx.App.WebLog.RelativeUrl(Permalink $"admin/page/{pageId}/edit")
|
||||
| None -> $"alert('unknown page object type {input.Type}')"
|
||||
|> sValue)
|
||||
|
||||
// A filter to generate a link that will edit a post
|
||||
it.Filters.AddFilter("edit_post_link",
|
||||
fun input _ ctx ->
|
||||
match input.ToObjectValue() with
|
||||
| :? PostListItem as post -> Some post.Id
|
||||
| :? string as theId -> Some theId
|
||||
| _ -> None
|
||||
|> function
|
||||
| Some postId -> ctx.App.WebLog.RelativeUrl(Permalink $"admin/post/{postId}/edit")
|
||||
| None -> $"alert('unknown post object type {input.Type}')"
|
||||
|> sValue)
|
||||
|
||||
// A filter to generate nav links, highlighting the active link (starts-with match)
|
||||
it.Filters.AddFilter("nav_link",
|
||||
fun input args ctx ->
|
||||
let app = ctx.App
|
||||
let extraPath = app.WebLog.ExtraPath
|
||||
let path = if extraPath = "" then "" else $"{extraPath[1..]}/"
|
||||
let url = input.ToStringValue()
|
||||
seq {
|
||||
"<li class=nav-item><a class=\"nav-link"
|
||||
if app.CurrentPage.StartsWith $"{path}{url}" then " active"
|
||||
"\" href=\""
|
||||
app.WebLog.RelativeUrl(Permalink url)
|
||||
"\">"
|
||||
args.At(0).ToStringValue()
|
||||
"</a>"
|
||||
}
|
||||
|> String.concat ""
|
||||
|> sValue)
|
||||
|
||||
// A filter to generate a relative link
|
||||
it.Filters.AddFilter("relative_link", fun input _ ctx -> sValue (permalink input ctx.App.WebLog.RelativeUrl))
|
||||
|
||||
// A filter to generate a link with posts tagged with the given tag
|
||||
it.Filters.AddFilter("tag_link",
|
||||
fun input _ ctx ->
|
||||
let tag = input.ToStringValue()
|
||||
ctx.App.TagMappings
|
||||
|> Array.tryFind (fun it -> it.Tag = tag)
|
||||
|> function
|
||||
| Some tagMap -> tagMap.UrlValue
|
||||
| None -> tag.Replace(" ", "+")
|
||||
|> function tagUrl -> ctx.App.WebLog.RelativeUrl(Permalink $"tag/{tagUrl}/")
|
||||
|> sValue)
|
||||
|
||||
// A filter to generate a link for theme asset (image, stylesheet, script, etc.)
|
||||
it.Filters.AddFilter("theme_asset", fun input _ ctx -> sValue (themeAsset input ctx))
|
||||
|
||||
// A filter to retrieve the value of a meta item from a list
|
||||
// (shorter than `{% assign item = list | where: "Name", [name] | first %}{{ item.value }}`)
|
||||
it.Filters.AddFilter("value",
|
||||
fun input args ctx ->
|
||||
let name = args.At(0).ToStringValue()
|
||||
let picker (value: FluidValue) =
|
||||
let item = value.ToObjectValue() :?> MetaItem
|
||||
if item.Name = name then Some item.Value else None
|
||||
(input :?> ArrayValue).Values
|
||||
|> Seq.tryPick picker
|
||||
|> Option.defaultValue $"-- {name} not found --"
|
||||
|> sValue)
|
||||
|
||||
it
|
||||
|
||||
|
||||
/// Fluid parser customized with myWebLog filters and tags
|
||||
let parser =
|
||||
// spacer
|
||||
let s = " "
|
||||
// Required return for tag delegates
|
||||
let ok () =
|
||||
VTask<Fluid.Ast.Completion> Fluid.Ast.Completion.Normal
|
||||
|
||||
let it = FluidParser()
|
||||
|
||||
// Create various items in the page header based on the state of the page being generated
|
||||
it.RegisterEmptyTag("page_head",
|
||||
fun writer encoder context ->
|
||||
let app = context.App
|
||||
// let getBool name =
|
||||
// defaultArg (context.Environments[0].[name] |> Option.ofObj |> Option.map Convert.ToBoolean) false
|
||||
|
||||
writer.WriteLine $"""{s}<meta name=generator content="{app.Generator}">"""
|
||||
|
||||
// Theme assets
|
||||
if assetExists "style.css" app.WebLog then
|
||||
themeAsset (StringValue "style.css") context
|
||||
|> sprintf "%s<link rel=stylesheet href=\"%s\">" s
|
||||
|> writer.WriteLine
|
||||
if assetExists "favicon.ico" app.WebLog then
|
||||
themeAsset (StringValue "favicon.ico") context
|
||||
|> sprintf "%s<link rel=icon href=\"%s\">" s
|
||||
|> writer.WriteLine
|
||||
|
||||
// RSS feeds and canonical URLs
|
||||
let feedLink title url =
|
||||
let escTitle = System.Web.HttpUtility.HtmlAttributeEncode title
|
||||
let relUrl = app.WebLog.RelativeUrl(Permalink url)
|
||||
$"""{s}<link rel=alternate type="application/rss+xml" title="{escTitle}" href="{relUrl}">"""
|
||||
|
||||
if app.WebLog.Rss.IsFeedEnabled && app.IsHome then
|
||||
writer.WriteLine(feedLink app.WebLog.Name app.WebLog.Rss.FeedName)
|
||||
writer.WriteLine $"""{s}<link rel=canonical href="{app.WebLog.AbsoluteUrl Permalink.Empty}">"""
|
||||
|
||||
if app.WebLog.Rss.IsCategoryEnabled && app.IsCategoryHome then
|
||||
let slug = context.AmbientValues["slug"] :?> string
|
||||
writer.WriteLine(feedLink app.WebLog.Name $"category/{slug}/{app.WebLog.Rss.FeedName}")
|
||||
|
||||
if app.WebLog.Rss.IsTagEnabled && app.IsTagHome then
|
||||
let slug = context.AmbientValues["slug"] :?> string
|
||||
writer.WriteLine(feedLink app.WebLog.Name $"tag/{slug}/{app.WebLog.Rss.FeedName}")
|
||||
|
||||
if app.IsPost then
|
||||
let post = (* context.Environments[0].["model"] *) obj() :?> PostDisplay
|
||||
let url = app.WebLog.AbsoluteUrl(Permalink post.Posts[0].Permalink)
|
||||
writer.WriteLine $"""{s}<link rel=canonical href="{url}">"""
|
||||
|
||||
if app.IsPage then
|
||||
let page = (* context.Environments[0].["page"] *) obj() :?> DisplayPage
|
||||
let url = app.WebLog.AbsoluteUrl(Permalink page.Permalink)
|
||||
writer.WriteLine $"""{s}<link rel=canonical href="{url}">"""
|
||||
|
||||
ok ())
|
||||
|
||||
// Create various items in the page footer based on the state of the page being generated
|
||||
it.RegisterEmptyTag("page_foot",
|
||||
fun writer encoder context ->
|
||||
let webLog = context.App.WebLog
|
||||
if webLog.AutoHtmx then
|
||||
writer.WriteLine $"{s}{RenderView.AsString.htmlNode Htmx.Script.minified}"
|
||||
if assetExists "script.js" webLog then
|
||||
themeAsset (StringValue "script.js") context
|
||||
|> sprintf "%s<script src=\"%s\"></script>" s
|
||||
|> writer.WriteLine
|
||||
ok ())
|
||||
|
||||
// Create links for a user to log on or off, and a dashboard link if they are logged off
|
||||
it.RegisterEmptyTag("user_links",
|
||||
fun writer encoder ctx ->
|
||||
let app = ctx.App
|
||||
let link it = app.WebLog.RelativeUrl(Permalink it)
|
||||
seq {
|
||||
"""<ul class="navbar-nav flex-grow-1 justify-content-end">"""
|
||||
match app.IsLoggedOn with
|
||||
| true ->
|
||||
$"""<li class=nav-item><a class=nav-link href="{link "admin/dashboard"}">Dashboard</a>"""
|
||||
$"""<li class=nav-item><a class=nav-link href="{link "user/log-off"}">Log Off</a>"""
|
||||
| false ->
|
||||
$"""<li class=nav-item><a class=nav-link href="{link "user/log-on"}">Log On</a>"""
|
||||
"</ul>"
|
||||
}
|
||||
|> Seq.iter writer.WriteLine
|
||||
ok())
|
||||
|
||||
it
|
||||
|
||||
|
||||
open MyWebLog.Data
|
||||
|
||||
/// Cache for parsed templates
|
||||
module Cache =
|
||||
|
||||
open System.Collections.Concurrent
|
||||
|
||||
/// Cache of parsed templates
|
||||
let private _cache = ConcurrentDictionary<string, IFluidTemplate> ()
|
||||
|
||||
/// Get a template for the given theme and template name
|
||||
let get (themeId: ThemeId) (templateName: string) (data: IData) = backgroundTask {
|
||||
let templatePath = $"{themeId}/{templateName}"
|
||||
match _cache.ContainsKey templatePath with
|
||||
| true -> return Ok _cache[templatePath]
|
||||
| false ->
|
||||
match! data.Theme.FindById themeId with
|
||||
| Some theme ->
|
||||
match theme.Templates |> List.tryFind (fun t -> t.Name = templateName) with
|
||||
| Some template ->
|
||||
_cache[templatePath] <- parser.Parse(template.Text)
|
||||
return Ok _cache[templatePath]
|
||||
| None ->
|
||||
return Error $"Theme ID {themeId} does not have a template named {templateName}"
|
||||
| None -> return Error $"Theme ID {themeId} does not exist"
|
||||
}
|
||||
|
||||
/// Get all theme/template names currently cached
|
||||
let allNames () =
|
||||
_cache.Keys |> Seq.sort |> Seq.toList
|
||||
|
||||
/// Invalidate all template cache entries for the given theme ID
|
||||
let invalidateTheme (themeId: ThemeId) =
|
||||
let keyPrefix = string themeId
|
||||
_cache.Keys
|
||||
|> Seq.filter _.StartsWith(keyPrefix)
|
||||
|> List.ofSeq
|
||||
|> List.iter (fun key -> match _cache.TryRemove key with _, _ -> ())
|
||||
|
||||
/// Remove all entries from the template cache
|
||||
let empty () =
|
||||
_cache.Clear()
|
||||
|
||||
|
||||
/// A file provider to retrieve files by theme
|
||||
type ThemeFileProvider(themeId: ThemeId, data: IData) =
|
||||
|
||||
interface IFileProvider with
|
||||
|
||||
member _.GetDirectoryContents _ =
|
||||
raise <| NotImplementedException "The theme file provider does not support directory listings"
|
||||
|
||||
member _.GetFileInfo path =
|
||||
match data.Theme.FindById themeId |> Async.AwaitTask |> Async.RunSynchronously with
|
||||
| Some theme ->
|
||||
match theme.Templates |> List.tryFind (fun t -> t.Name = path) with
|
||||
| Some template ->
|
||||
{ new IFileInfo with
|
||||
member _.Exists = true
|
||||
member _.IsDirectory = false
|
||||
member _.LastModified = DateTimeOffset.Now
|
||||
member _.Length = int64 template.Text.Length
|
||||
member _.Name = template.Name.Split '/' |> Array.last
|
||||
member _.PhysicalPath = null
|
||||
member _.CreateReadStream() =
|
||||
new MemoryStream(Encoding.UTF8.GetBytes template.Text) }
|
||||
| None -> NotFoundFileInfo path
|
||||
| None -> NotFoundFileInfo path
|
||||
|
||||
member _.Watch _ =
|
||||
raise <| NotImplementedException "The theme file provider does not support watching for changes"
|
||||
|
||||
|
||||
/// Render a template to a string
|
||||
let render (template: IFluidTemplate) (viewCtx: AppViewContext) data =
|
||||
let opts = options ()
|
||||
opts.FileProvider <- ThemeFileProvider(viewCtx.WebLog.ThemeId, data)
|
||||
template.Render(TemplateContext(viewCtx, opts, true))
|
126
src/MyWebLog/ViewContext.fs
Normal file
126
src/MyWebLog/ViewContext.fs
Normal file
@ -0,0 +1,126 @@
|
||||
/// View rendering context for myWebLog
|
||||
[<AutoOpen>]
|
||||
module MyWebLog.ViewContext
|
||||
|
||||
open Microsoft.AspNetCore.Antiforgery
|
||||
open MyWebLog.ViewModels
|
||||
|
||||
/// The rendering context for this application
|
||||
[<NoComparison; NoEquality>]
|
||||
type AppViewContext = {
|
||||
/// The web log for this request
|
||||
WebLog: WebLog
|
||||
|
||||
/// The ID of the current user
|
||||
UserId: WebLogUserId option
|
||||
|
||||
/// The title of the page being rendered
|
||||
PageTitle: string
|
||||
|
||||
/// The subtitle for the page
|
||||
Subtitle: string option
|
||||
|
||||
/// The anti-Cross Site Request Forgery (CSRF) token set to use when rendering a form
|
||||
Csrf: AntiforgeryTokenSet option
|
||||
|
||||
/// The page list for the web log
|
||||
PageList: DisplayPage array
|
||||
|
||||
/// Categories and post counts for the web log
|
||||
Categories: DisplayCategory array
|
||||
|
||||
/// Tag mappings
|
||||
TagMappings: TagMap array
|
||||
|
||||
/// The URL of the page being rendered
|
||||
CurrentPage: string
|
||||
|
||||
/// User messages
|
||||
Messages: UserMessage array
|
||||
|
||||
/// The generator string for the rendered page
|
||||
Generator: string
|
||||
|
||||
/// The payload for this page (see other properties that wrap this one)
|
||||
Payload: obj
|
||||
|
||||
/// The content of a page (wrapped when rendering the layout)
|
||||
Content: string
|
||||
|
||||
/// A string to load the minified htmx script
|
||||
HtmxScript: string
|
||||
|
||||
/// Whether the current user is an author
|
||||
IsAuthor: bool
|
||||
|
||||
/// Whether the current user is an editor (implies author)
|
||||
IsEditor: bool
|
||||
|
||||
/// Whether the current user is a web log administrator (implies author and editor)
|
||||
IsWebLogAdmin: bool
|
||||
|
||||
/// Whether the current user is an installation administrator (implies all web log rights)
|
||||
IsAdministrator: bool
|
||||
|
||||
/// Whether the current page is the home page of the web log
|
||||
IsHome: bool
|
||||
|
||||
/// Whether the current page is a category archive page
|
||||
IsCategory: bool
|
||||
|
||||
/// Whether the current page is a category archive home page
|
||||
IsCategoryHome: bool
|
||||
|
||||
/// Whether the current page is a tag archive page
|
||||
IsTag: bool
|
||||
|
||||
/// Whether the current page is a tag archive home page
|
||||
IsTagHome: bool
|
||||
|
||||
/// Whether the current page is a single post
|
||||
IsPost: bool
|
||||
|
||||
/// Whether the current page is a static page
|
||||
IsPage: bool
|
||||
|
||||
/// The slug for a category or tag
|
||||
Slug: string option }
|
||||
with
|
||||
|
||||
/// Whether there is a user logged on
|
||||
member this.IsLoggedOn = Option.isSome this.UserId
|
||||
|
||||
member this.Page =
|
||||
this.Payload :?> DisplayPage
|
||||
|
||||
member this.Posts =
|
||||
this.Payload :?> PostDisplay
|
||||
|
||||
/// An empty view context
|
||||
static member Empty =
|
||||
{ WebLog = WebLog.Empty
|
||||
UserId = None
|
||||
PageTitle = ""
|
||||
Subtitle = None
|
||||
Csrf = None
|
||||
PageList = [||]
|
||||
Categories = [||]
|
||||
TagMappings = [||]
|
||||
CurrentPage = ""
|
||||
Messages = [||]
|
||||
Generator = ""
|
||||
Payload = obj ()
|
||||
Content = ""
|
||||
HtmxScript = ""
|
||||
IsAuthor = false
|
||||
IsEditor = false
|
||||
IsWebLogAdmin = false
|
||||
IsAdministrator = false
|
||||
IsHome = false
|
||||
IsCategory = false
|
||||
IsCategoryHome = false
|
||||
IsTag = false
|
||||
IsTagHome = false
|
||||
IsPost = false
|
||||
IsPage = false
|
||||
Slug = None }
|
@ -8,7 +8,7 @@ open MyWebLog.ViewModels
|
||||
|
||||
/// The administrator dashboard
|
||||
let dashboard (themes: Theme list) app = [
|
||||
let templates = TemplateCache.allNames ()
|
||||
let templates = Template.Cache.allNames ()
|
||||
let cacheBaseUrl = relUrl app "admin/cache/"
|
||||
let webLogCacheUrl = $"{cacheBaseUrl}web-log/"
|
||||
let themeCacheUrl = $"{cacheBaseUrl}theme/"
|
||||
|
@ -1,7 +1,6 @@
|
||||
[<AutoOpen>]
|
||||
module MyWebLog.Views.Helpers
|
||||
|
||||
open Microsoft.AspNetCore.Antiforgery
|
||||
open Giraffe.ViewEngine
|
||||
open Giraffe.ViewEngine.Accessibility
|
||||
open Giraffe.ViewEngine.Htmx
|
||||
@ -10,56 +9,6 @@ open MyWebLog.ViewModels
|
||||
open NodaTime
|
||||
open NodaTime.Text
|
||||
|
||||
/// The rendering context for this application
|
||||
[<NoComparison; NoEquality>]
|
||||
type AppViewContext = {
|
||||
/// The web log for this request
|
||||
WebLog: WebLog
|
||||
|
||||
/// The ID of the current user
|
||||
UserId: WebLogUserId option
|
||||
|
||||
/// The title of the page being rendered
|
||||
PageTitle: string
|
||||
|
||||
/// The anti-Cross Site Request Forgery (CSRF) token set to use when rendering a form
|
||||
Csrf: AntiforgeryTokenSet option
|
||||
|
||||
/// The page list for the web log
|
||||
PageList: DisplayPage array
|
||||
|
||||
/// Categories and post counts for the web log
|
||||
Categories: DisplayCategory array
|
||||
|
||||
/// The URL of the page being rendered
|
||||
CurrentPage: string
|
||||
|
||||
/// User messages
|
||||
Messages: UserMessage array
|
||||
|
||||
/// The generator string for the rendered page
|
||||
Generator: string
|
||||
|
||||
/// A string to load the minified htmx script
|
||||
HtmxScript: string
|
||||
|
||||
/// Whether the current user is an author
|
||||
IsAuthor: bool
|
||||
|
||||
/// Whether the current user is an editor (implies author)
|
||||
IsEditor: bool
|
||||
|
||||
/// Whether the current user is a web log administrator (implies author and editor)
|
||||
IsWebLogAdmin: bool
|
||||
|
||||
/// Whether the current user is an installation administrator (implies all web log rights)
|
||||
IsAdministrator: bool
|
||||
} with
|
||||
|
||||
/// Whether there is a user logged on
|
||||
member this.IsLoggedOn = Option.isSome this.UserId
|
||||
|
||||
|
||||
/// Create a relative URL for the current web log
|
||||
let relUrl app =
|
||||
Permalink >> app.WebLog.RelativeUrl
|
||||
|
@ -1,5 +1,5 @@
|
||||
{
|
||||
"Generator": "myWebLog 2.2",
|
||||
"Generator": "myWebLog 3",
|
||||
"Logging": {
|
||||
"LogLevel": {
|
||||
"MyWebLog.Handlers": "Information"
|
||||
|
Loading…
Reference in New Issue
Block a user