Misc changes over the past month or so

- RSS feeds partially done
- All three initial target themes, as well as the default theme, display
properly
This commit is contained in:
Daniel J. Summers 2016-11-07 22:17:00 -06:00
parent f4d520e34b
commit e5700727e9
10 changed files with 281 additions and 168 deletions

5
.gitignore vendored
View File

@ -252,3 +252,8 @@ paket-files/
# JetBrains Rider # JetBrains Rider
.idea/ .idea/
*.sln.iml *.sln.iml
# Personal themes used to test initial release
src/MyWebLog/views/themes/daniel-j-summers
src/MyWebLog/views/themes/daniels-weekly-devotions
src/MyWebLog/views/themes/djs-consulting

View File

@ -155,9 +155,10 @@ type Startup() =
let Run () = let Run () =
use host =
WebHostBuilder() WebHostBuilder()
.UseContentRoot(System.IO.Directory.GetCurrentDirectory()) .UseContentRoot(System.IO.Directory.GetCurrentDirectory())
.UseKestrel() .UseKestrel()
.UseStartup<Startup>() .UseStartup<Startup>()
.Build() .Build()
.Run() host.Run()

View File

@ -13,7 +13,14 @@ open Nancy.Session.Persistable
open NodaTime open NodaTime
open RethinkDb.Driver.Net open RethinkDb.Driver.Net
open System open System
//open System.ServiceModel.Syndication open System.Xml.Linq
type NewsItem =
{ Title : string
Link : string
ReleaseDate : DateTime
Description : string
}
/// Routes dealing with posts (including the home page, /tag, /category, RSS, and catch-all routes) /// Routes dealing with posts (including the home page, /tag, /category, RSS, and catch-all routes)
type PostModule(data : IMyWebLogData, clock : IClock) as this = type PostModule(data : IMyWebLogData, clock : IClock) as this =
@ -28,8 +35,45 @@ type PostModule(data : IMyWebLogData, clock : IClock) as this =
/// Generate an RSS/Atom feed of the latest posts /// Generate an RSS/Atom feed of the latest posts
let generateFeed format : obj = let generateFeed format : obj =
this.NotFound () let myChannelFeed channelTitle channelLink channelDescription (items : NewsItem list) =
(* let posts = findFeedPosts data this.WebLog.Id 10 let xn = XName.Get
let elem name (valu:string) = XElement(xn name, valu)
let elems =
items
|> List.sortBy (fun i -> i.ReleaseDate)
|> List.map (fun i ->
XElement
(xn "item",
elem "title" (System.Net.WebUtility.HtmlEncode i.Title),
elem "link" i.Link,
elem "guid" i.Link,
elem "pubDate" (i.ReleaseDate.ToString "r"),
elem "description" (System.Net.WebUtility.HtmlEncode i.Description)
))
XDocument(
XDeclaration("1.0", "utf-8", "yes"),
XElement
(xn "rss",
XAttribute(xn "version", "2.0"),
elem "title" channelTitle,
elem "link" channelLink,
elem "description" (defaultArg channelDescription ""),
elem "language" "en-us",
XElement(xn "channel", elems))
|> box)
|> box
let schemeAndUrl = sprintf "%s://%s" this.Request.Url.Scheme this.WebLog.UrlBase
findFeedPosts data this.WebLog.Id 10
|> List.map (fun (post, _) ->
{ Title = post.Title
Link = sprintf "%s/%s" schemeAndUrl post.Permalink
ReleaseDate = Instant.FromUnixTimeTicks(post.PublishedOn).ToDateTimeOffset().DateTime
Description = post.Text
})
|> myChannelFeed this.WebLog.Name schemeAndUrl this.WebLog.Subtitle
// TODO: how to return this?
(*
let feed = let feed =
SyndicationFeed( SyndicationFeed(
this.WebLog.Name, defaultArg this.WebLog.Subtitle null, this.WebLog.Name, defaultArg this.WebLog.Subtitle null,

View File

@ -13,25 +13,32 @@ let private category (webLogId : string) (catId : string) =
/// Get all categories for a web log /// Get all categories for a web log
let getAllCategories conn (webLogId : string) = let getAllCategories conn (webLogId : string) =
r.Table(Table.Category) async {
return! r.Table(Table.Category)
.GetAll(webLogId).OptArg("index", "WebLogId") .GetAll(webLogId).OptArg("index", "WebLogId")
.OrderBy("Name") .OrderBy("Name")
.RunResultAsync<Category list>(conn) .RunResultAsync<Category list> conn
|> await }
|> Async.RunSynchronously
/// Get a specific category by its Id /// Get a specific category by its Id
let tryFindCategory conn webLogId catId : Category option = let tryFindCategory conn webLogId catId : Category option =
(category webLogId catId) async {
.RunResultAsync<Category>(conn) let! catt = (category webLogId catId).RunResultAsync<Category> conn
|> await return catt
|> box |> box
|> function null -> None | cat -> Some <| unbox cat |> function null -> None | cat -> Some <| unbox cat
}
|> Async.RunSynchronously
/// Add a category /// Add a category
let addCategory conn (cat : Category) = let addCategory conn (cat : Category) =
r.Table(Table.Category) async {
do! r.Table(Table.Category)
.Insert(cat) .Insert(cat)
.RunResultAsync(conn) |> await |> ignore .RunResultAsync conn
}
|> Async.RunSynchronously
type CategoryUpdateRecord = type CategoryUpdateRecord =
{ Name : string { Name : string
@ -39,23 +46,29 @@ type CategoryUpdateRecord =
Description : string option Description : string option
ParentId : string option ParentId : string option
} }
/// Update a category /// Update a category
let updateCategory conn (cat : Category) = let updateCategory conn (cat : Category) =
(category cat.WebLogId cat.Id) async {
do! (category cat.WebLogId cat.Id)
.Update({ CategoryUpdateRecord.Name = cat.Name .Update({ CategoryUpdateRecord.Name = cat.Name
Slug = cat.Slug Slug = cat.Slug
Description = cat.Description Description = cat.Description
ParentId = cat.ParentId }) ParentId = cat.ParentId
.RunResultAsync(conn) |> await |> ignore })
.RunResultAsync conn
}
|> Async.RunSynchronously
type CategoryChildrenUpdateRecord = type CategoryChildrenUpdateRecord =
{ Children : string list } { Children : string list }
/// Update a category's children /// Update a category's children
let updateChildren conn webLogId parentId (children : string list) = let updateChildren conn webLogId parentId (children : string list) =
(category webLogId parentId) async {
do! (category webLogId parentId)
.Update({ CategoryChildrenUpdateRecord.Children = children }) .Update({ CategoryChildrenUpdateRecord.Children = children })
.RunResultAsync(conn) |> await |> ignore .RunResultAsync conn
}
|> Async.RunSynchronously
type CategoryParentUpdateRecord = type CategoryParentUpdateRecord =
{ ParentId : string option } { ParentId : string option }
@ -63,6 +76,7 @@ type PostCategoriesUpdateRecord =
{ CategoryIds : string list } { CategoryIds : string list }
/// Delete a category /// Delete a category
let deleteCategory conn (cat : Category) = let deleteCategory conn (cat : Category) =
async {
// Remove the category from its parent // Remove the category from its parent
match cat.ParentId with match cat.ParentId with
| Some parentId -> match tryFindCategory conn cat.WebLogId parentId with | Some parentId -> match tryFindCategory conn cat.WebLogId parentId with
@ -74,32 +88,47 @@ let deleteCategory conn (cat : Category) =
// Move this category's children to its parent // Move this category's children to its parent
let newParent = { CategoryParentUpdateRecord.ParentId = cat.ParentId } let newParent = { CategoryParentUpdateRecord.ParentId = cat.ParentId }
cat.Children cat.Children
|> List.iter (fun childId -> (category cat.WebLogId childId) |> List.map (fun childId ->
async {
do! (category cat.WebLogId childId)
.Update(newParent) .Update(newParent)
.RunResultAsync(conn) |> await |> ignore) .RunResultAsync conn
})
|> List.iter Async.RunSynchronously
// Remove the category from posts where it is assigned // Remove the category from posts where it is assigned
let! posts =
r.Table(Table.Post) r.Table(Table.Post)
.GetAll(cat.WebLogId).OptArg("index", "WebLogId") .GetAll(cat.WebLogId).OptArg("index", "WebLogId")
.Filter(ReqlFunction1(fun p -> upcast p.["CategoryIds"].Contains(cat.Id))) .Filter(ReqlFunction1(fun p -> upcast p.["CategoryIds"].Contains(cat.Id)))
.RunResultAsync<Post list>(conn) .RunResultAsync<Post list> conn
|> await |> Async.AwaitTask
|> List.iter (fun post -> let newCats = posts
|> List.map (fun post ->
async {
let newCats =
{ PostCategoriesUpdateRecord.CategoryIds = post.CategoryIds { PostCategoriesUpdateRecord.CategoryIds = post.CategoryIds
|> List.filter (fun c -> c <> cat.Id) } |> List.filter (fun c -> c <> cat.Id)
r.Table(Table.Post) }
do! r.Table(Table.Post)
.Get(post.Id) .Get(post.Id)
.Update(newCats) .Update(newCats)
.RunResultAsync(conn) |> await |> ignore) .RunResultAsync conn
})
|> List.iter Async.RunSynchronously
// Now, delete the category // Now, delete the category
r.Table(Table.Category) do! r.Table(Table.Category)
.Get(cat.Id) .Get(cat.Id)
.Delete() .Delete()
.RunResultAsync(conn) |> await |> ignore .RunResultAsync(conn)
}
|> Async.RunSynchronously
/// Get a category by its slug /// Get a category by its slug
let tryFindCategoryBySlug conn (webLogId : string) (slug : string) = let tryFindCategoryBySlug conn (webLogId : string) (slug : string) =
r.Table(Table.Category) async {
let! cat = r.Table(Table.Category)
.GetAll(r.Array(webLogId, slug)).OptArg("index", "Slug") .GetAll(r.Array(webLogId, slug)).OptArg("index", "Slug")
.RunResultAsync<Category list>(conn) .RunResultAsync<Category list> conn
|> await return cat |> List.tryHead
|> List.tryHead }
|> Async.RunSynchronously

View File

@ -1,7 +1,18 @@
[<AutoOpen>] [<AutoOpen>]
module MyWebLog.Data.RethinkDB.Extensions module MyWebLog.Data.RethinkDB.Extensions
open RethinkDb.Driver.Ast open System.Threading.Tasks
open RethinkDb.Driver.Net
let await task = task |> Async.AwaitTask |> Async.RunSynchronously let await task = task |> Async.AwaitTask |> Async.RunSynchronously
// H/T: Suave
type AsyncBuilder with
/// An extension method that overloads the standard 'Bind' of the 'async' builder. The new overload awaits on
/// a standard .NET task
member x.Bind(t : Task<'T>, f:'T -> Async<'R>) : Async<'R> = async.Bind(Async.AwaitTask t, f)
/// An extension method that overloads the standard 'Bind' of the 'async' builder. The new overload awaits on
/// a standard .NET task which does not commpute a value
member x.Bind(t : Task, f : unit -> Async<'R>) : Async<'R> = async.Bind(Async.AwaitTask t, f)
member x.ReturnFrom(t : Task<'T>) = Async.AwaitTask t

View File

@ -6,42 +6,42 @@ open RethinkDb.Driver.Net
/// RethinkDB implementation of myWebLog data persistence /// RethinkDB implementation of myWebLog data persistence
type RethinkMyWebLogData(conn : IConnection, cfg : DataConfig) = type RethinkMyWebLogData(conn : IConnection, cfg : DataConfig) =
interface IMyWebLogData with interface IMyWebLogData with
member this.SetUp = fun () -> SetUp.startUpCheck cfg member __.SetUp = fun () -> SetUp.startUpCheck cfg
member this.AllCategories = Category.getAllCategories conn member __.AllCategories = Category.getAllCategories conn
member this.CategoryById = Category.tryFindCategory conn member __.CategoryById = Category.tryFindCategory conn
member this.CategoryBySlug = Category.tryFindCategoryBySlug conn member __.CategoryBySlug = Category.tryFindCategoryBySlug conn
member this.AddCategory = Category.addCategory conn member __.AddCategory = Category.addCategory conn
member this.UpdateCategory = Category.updateCategory conn member __.UpdateCategory = Category.updateCategory conn
member this.UpdateChildren = Category.updateChildren conn member __.UpdateChildren = Category.updateChildren conn
member this.DeleteCategory = Category.deleteCategory conn member __.DeleteCategory = Category.deleteCategory conn
member this.PageById = Page.tryFindPageById conn member __.PageById = Page.tryFindPageById conn
member this.PageByPermalink = Page.tryFindPageByPermalink conn member __.PageByPermalink = Page.tryFindPageByPermalink conn
member this.AllPages = Page.findAllPages conn member __.AllPages = Page.findAllPages conn
member this.AddPage = Page.addPage conn member __.AddPage = Page.addPage conn
member this.UpdatePage = Page.updatePage conn member __.UpdatePage = Page.updatePage conn
member this.DeletePage = Page.deletePage conn member __.DeletePage = Page.deletePage conn
member this.PageOfPublishedPosts = Post.findPageOfPublishedPosts conn member __.PageOfPublishedPosts = Post.findPageOfPublishedPosts conn
member this.PageOfCategorizedPosts = Post.findPageOfCategorizedPosts conn member __.PageOfCategorizedPosts = Post.findPageOfCategorizedPosts conn
member this.PageOfTaggedPosts = Post.findPageOfTaggedPosts conn member __.PageOfTaggedPosts = Post.findPageOfTaggedPosts conn
member this.NewerPost = Post.tryFindNewerPost conn member __.NewerPost = Post.tryFindNewerPost conn
member this.NewerCategorizedPost = Post.tryFindNewerCategorizedPost conn member __.NewerCategorizedPost = Post.tryFindNewerCategorizedPost conn
member this.NewerTaggedPost = Post.tryFindNewerTaggedPost conn member __.NewerTaggedPost = Post.tryFindNewerTaggedPost conn
member this.OlderPost = Post.tryFindOlderPost conn member __.OlderPost = Post.tryFindOlderPost conn
member this.OlderCategorizedPost = Post.tryFindOlderCategorizedPost conn member __.OlderCategorizedPost = Post.tryFindOlderCategorizedPost conn
member this.OlderTaggedPost = Post.tryFindOlderTaggedPost conn member __.OlderTaggedPost = Post.tryFindOlderTaggedPost conn
member this.PageOfAllPosts = Post.findPageOfAllPosts conn member __.PageOfAllPosts = Post.findPageOfAllPosts conn
member this.PostById = Post.tryFindPost conn member __.PostById = Post.tryFindPost conn
member this.PostByPermalink = Post.tryFindPostByPermalink conn member __.PostByPermalink = Post.tryFindPostByPermalink conn
member this.PostByPriorPermalink = Post.tryFindPostByPriorPermalink conn member __.PostByPriorPermalink = Post.tryFindPostByPriorPermalink conn
member this.FeedPosts = Post.findFeedPosts conn member __.FeedPosts = Post.findFeedPosts conn
member this.AddPost = Post.addPost conn member __.AddPost = Post.addPost conn
member this.UpdatePost = Post.updatePost conn member __.UpdatePost = Post.updatePost conn
member this.LogOn = User.tryUserLogOn conn member __.LogOn = User.tryUserLogOn conn
member this.WebLogByUrlBase = WebLog.tryFindWebLogByUrlBase conn member __.WebLogByUrlBase = WebLog.tryFindWebLogByUrlBase conn
member this.DashboardCounts = WebLog.findDashboardCounts conn member __.DashboardCounts = WebLog.findDashboardCounts conn

View File

@ -10,45 +10,56 @@ let private logStepDone () = Console.Out.WriteLine (" done.")
/// Ensure the myWebLog database exists /// Ensure the myWebLog database exists
let private checkDatabase (cfg : DataConfig) = let private checkDatabase (cfg : DataConfig) =
async {
logStep "|> Checking database" logStep "|> Checking database"
let dbs = r.DbList().RunResultAsync<string list>(cfg.Conn) |> await let! dbs = r.DbList().RunResultAsync<string list> cfg.Conn
match List.contains cfg.Database dbs with match List.contains cfg.Database dbs with
| true -> () | true -> ()
| _ -> logStepStart (sprintf " %s database not found - creating" cfg.Database) | _ -> logStepStart (sprintf " %s database not found - creating" cfg.Database)
r.DbCreate(cfg.Database).RunResultAsync(cfg.Conn) |> await |> ignore do! r.DbCreate(cfg.Database).RunResultAsync cfg.Conn
logStepDone () logStepDone ()
}
/// Ensure all required tables exist /// Ensure all required tables exist
let private checkTables cfg = let private checkTables cfg =
async {
logStep "|> Checking tables" logStep "|> Checking tables"
let tables = r.Db(cfg.Database).TableList().RunResultAsync<string list>(cfg.Conn) |> await let! tables = r.Db(cfg.Database).TableList().RunResultAsync<string list> cfg.Conn
[ Table.Category; Table.Comment; Table.Page; Table.Post; Table.User; Table.WebLog ] [ Table.Category; Table.Comment; Table.Page; Table.Post; Table.User; Table.WebLog ]
|> List.filter (fun tbl -> not (List.contains tbl tables)) |> List.filter (fun tbl -> not (List.contains tbl tables))
|> List.iter (fun tbl -> logStepStart (sprintf " Creating table %s" tbl) |> List.iter (fun tbl -> logStepStart (sprintf " Creating table %s" tbl)
(r.TableCreate tbl).RunResultAsync(cfg.Conn) |> await |> ignore async { do! (r.TableCreate tbl).RunResultAsync cfg.Conn } |> Async.RunSynchronously
logStepDone ()) logStepDone ())
}
/// Shorthand to get the table /// Shorthand to get the table
let private tbl cfg table = r.Db(cfg.Database).Table(table) let private tbl cfg table = r.Db(cfg.Database).Table table
/// Create the given index /// Create the given index
let private createIndex cfg table (index : string * (ReqlExpr -> obj) option) = let private createIndex cfg table (index : string * (ReqlExpr -> obj) option) =
async {
let idxName, idxFunc = index let idxName, idxFunc = index
logStepStart (sprintf """ Creating index "%s" on table %s""" idxName table) logStepStart (sprintf """ Creating index "%s" on table %s""" idxName table)
(match idxFunc with do! (match idxFunc with
| Some f -> (tbl cfg table).IndexCreate(idxName, f) | Some f -> (tbl cfg table).IndexCreate(idxName, f)
| None -> (tbl cfg table).IndexCreate(idxName)) | None -> (tbl cfg table).IndexCreate(idxName))
.RunResultAsync(cfg.Conn) .RunResultAsync cfg.Conn
|> await |> ignore do! (tbl cfg table).IndexWait(idxName).RunResultAsync cfg.Conn
(tbl cfg table).IndexWait(idxName).RunResultAsync(cfg.Conn) |> await |> ignore
logStepDone () logStepDone ()
}
/// Ensure that the given indexes exist, and create them if required /// Ensure that the given indexes exist, and create them if required
let private ensureIndexes cfg (indexes : (string * (string * (ReqlExpr -> obj) option) list) list) = let private ensureIndexes cfg (indexes : (string * (string * (ReqlExpr -> obj) option) list) list) =
let ensureForTable (tblName, idxs) = let ensureForTable (tblName, idxs) =
let idx = (tbl cfg tblName).IndexList().RunResultAsync<string list>(cfg.Conn) |> await async {
let! idx = (tbl cfg tblName).IndexList().RunResultAsync<string list> cfg.Conn
idxs idxs
|> List.iter (fun index -> match List.contains (fst index) idx with true -> () | _ -> createIndex cfg tblName index) |> List.filter (fun (idxName, _) -> not (List.contains idxName idx))
|> List.map (fun index -> createIndex cfg tblName index)
|> List.iter Async.RunSynchronously
}
|> Async.RunSynchronously
indexes indexes
|> List.iter ensureForTable |> List.iter ensureForTable
@ -80,8 +91,11 @@ let private checkIndexes cfg =
/// Start up checks to ensure the database, tables, and indexes exist /// Start up checks to ensure the database, tables, and indexes exist
let startUpCheck cfg = let startUpCheck cfg =
async {
logStep "Database Start Up Checks Starting" logStep "Database Start Up Checks Starting"
checkDatabase cfg do! checkDatabase cfg
checkTables cfg do! checkTables cfg
checkIndexes cfg checkIndexes cfg
logStep "Database Start Up Checks Complete" logStep "Database Start Up Checks Complete"
}
|> Async.RunSynchronously

View File

@ -10,9 +10,12 @@ let private r = RethinkDb.Driver.RethinkDB.R
// including it in an index does not get any performance gain, and would unnecessarily bloat the index. See // including it in an index does not get any performance gain, and would unnecessarily bloat the index. See
// http://rethinkdb.com/docs/secondary-indexes/java/ for more information. // http://rethinkdb.com/docs/secondary-indexes/java/ for more information.
let tryUserLogOn conn (email : string) (passwordHash : string) = let tryUserLogOn conn (email : string) (passwordHash : string) =
async {
let! user =
r.Table(Table.User) r.Table(Table.User)
.GetAll(email).OptArg("index", "UserName") .GetAll(email).OptArg("index", "UserName")
.Filter(ReqlFunction1(fun u -> upcast u.["PasswordHash"].Eq(passwordHash))) .Filter(ReqlFunction1(fun u -> upcast u.["PasswordHash"].Eq(passwordHash)))
.RunResultAsync<User list>(conn) .RunResultAsync<User list> conn
|> await return user |> List.tryHead
|> List.tryHead }
|> Async.RunSynchronously

View File

@ -7,6 +7,8 @@ let private r = RethinkDb.Driver.RethinkDB.R
/// Detemine the web log by the URL base /// Detemine the web log by the URL base
let tryFindWebLogByUrlBase conn (urlBase : string) = let tryFindWebLogByUrlBase conn (urlBase : string) =
async {
let! cursor =
r.Table(Table.WebLog) r.Table(Table.WebLog)
.GetAll(urlBase).OptArg("index", "UrlBase") .GetAll(urlBase).OptArg("index", "UrlBase")
.Merge(ReqlFunction1(fun w -> .Merge(ReqlFunction1(fun w ->
@ -16,15 +18,19 @@ let tryFindWebLogByUrlBase conn (urlBase : string) =
.OrderBy("Title") .OrderBy("Title")
.Pluck("Title", "Permalink") .Pluck("Title", "Permalink")
.CoerceTo("array")))) .CoerceTo("array"))))
.RunResultAsync<WebLog list>(conn) .RunCursorAsync<WebLog> conn
|> await return cursor |> Seq.tryHead
|> List.tryHead }
|> Async.RunSynchronously
/// Get counts for the admin dashboard /// Get counts for the admin dashboard
let findDashboardCounts conn (webLogId : string) = let findDashboardCounts conn (webLogId : string) =
async {
return!
r.Expr( r.HashMap("Pages", r.Table(Table.Page ).GetAll(webLogId).OptArg("index", "WebLogId").Count())) r.Expr( r.HashMap("Pages", r.Table(Table.Page ).GetAll(webLogId).OptArg("index", "WebLogId").Count()))
.Merge(r.HashMap("Posts", r.Table(Table.Post ).GetAll(webLogId).OptArg("index", "WebLogId").Count())) .Merge(r.HashMap("Posts", r.Table(Table.Post ).GetAll(webLogId).OptArg("index", "WebLogId").Count()))
.Merge(r.HashMap("Categories", r.Table(Table.Category).GetAll(webLogId).OptArg("index", "WebLogId").Count())) .Merge(r.HashMap("Categories", r.Table(Table.Category).GetAll(webLogId).OptArg("index", "WebLogId").Count()))
.RunResultAsync<DashboardCounts>(conn) .RunResultAsync<DashboardCounts> conn
|> await }
|> Async.RunSynchronously

View File

@ -19,7 +19,7 @@ let findAllPages (data : IMyWebLogData) webLogId = data.AllPages webLogId
/// Save a page /// Save a page
let savePage (data : IMyWebLogData) (page : Page) = let savePage (data : IMyWebLogData) (page : Page) =
match page.Id with match page.Id with
| "new" -> let newPg = { page with Id = string <| System.Guid.NewGuid() } | "new" -> let newPg = { page with Id = string <| System.Guid.NewGuid () }
data.AddPage newPg data.AddPage newPg
newPg.Id newPg.Id
| _ -> data.UpdatePage page | _ -> data.UpdatePage page