bit-badger/myWebLog
1
0
Fork 0
Code Issues 4 Pull Requests Packages Projects Releases 11 Activity

Misc changes over the past month or so

Browse Source 
- 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
.gitignore vendored
View File

@ -252,3 +252,8 @@ paket-files/
# JetBrains Rider
.idea/
*.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

13
src/MyWebLog.App/App.fs
View File

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

50
src/MyWebLog.App/PostModule.fs
View File

@ -13,7 +13,14 @@ open Nancy.Session.Persistable
open NodaTime
open RethinkDb.Driver.Net
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)
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
let generateFeed format : obj =
this.NotFound ()
(* let posts = findFeedPosts data this.WebLog.Id 10
let myChannelFeed channelTitle channelLink channelDescription (items : NewsItem list) =
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 =
SyndicationFeed(
this.WebLog.Name, defaultArg this.WebLog.Subtitle null,

149
src/MyWebLog.Data.RethinkDB/Category.fs
View File

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

15
src/MyWebLog.Data.RethinkDB/Extensions.fs
View File

@ -1,7 +1,18 @@
[<AutoOpen>]
module MyWebLog.Data.RethinkDB.Extensions
open RethinkDb.Driver.Ast
open RethinkDb.Driver.Net
open System.Threading.Tasks
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

66
src/MyWebLog.Data.RethinkDB/RethinkMyWebLogData.fs
View File

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

94
src/MyWebLog.Data.RethinkDB/SetUp.fs
View File

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

15
src/MyWebLog.Data.RethinkDB/User.fs
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
// http://rethinkdb.com/docs/secondary-indexes/java/ for more information.
let tryUserLogOn conn (email : string) (passwordHash : string) =
r.Table(Table.User)
.GetAll(email).OptArg("index", "UserName")
.Filter(ReqlFunction1(fun u -> upcast u.["PasswordHash"].Eq(passwordHash)))
.RunResultAsync<User list>(conn)
|> await
|> List.tryHead
async {
let! user =
r.Table(Table.User)
.GetAll(email).OptArg("index", "UserName")
.Filter(ReqlFunction1(fun u -> upcast u.["PasswordHash"].Eq(passwordHash)))
.RunResultAsync<User list> conn
return user |> List.tryHead
}
|> Async.RunSynchronously

40
src/MyWebLog.Data.RethinkDB/WebLog.fs
View File

@ -7,24 +7,30 @@ let private r = RethinkDb.Driver.RethinkDB.R
/// Detemine the web log by the URL base
let tryFindWebLogByUrlBase conn (urlBase : string) =
r.Table(Table.WebLog)
.GetAll(urlBase).OptArg("index", "UrlBase")
.Merge(ReqlFunction1(fun w ->
upcast r.HashMap("PageList", r.Table(Table.Page)
.GetAll(w.G("id")).OptArg("index", "WebLogId")
.Filter(ReqlFunction1(fun pg -> upcast pg.["ShowInPageList"].Eq(true)))
.OrderBy("Title")
.Pluck("Title", "Permalink")
.CoerceTo("array"))))
.RunResultAsync<WebLog list>(conn)
|> await
|> List.tryHead
async {
let! cursor =
r.Table(Table.WebLog)
.GetAll(urlBase).OptArg("index", "UrlBase")
.Merge(ReqlFunction1(fun w ->
upcast r.HashMap("PageList", r.Table(Table.Page)
.GetAll(w.G("id")).OptArg("index", "WebLogId")
.Filter(ReqlFunction1(fun pg -> upcast pg.["ShowInPageList"].Eq(true)))
.OrderBy("Title")
.Pluck("Title", "Permalink")
.CoerceTo("array"))))
.RunCursorAsync<WebLog> conn
return cursor |> Seq.tryHead
}
|> Async.RunSynchronously
/// Get counts for the admin dashboard
let findDashboardCounts conn (webLogId : string) =
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("Categories", r.Table(Table.Category).GetAll(webLogId).OptArg("index", "WebLogId").Count()))
.RunResultAsync<DashboardCounts>(conn)
|> await
async {
return!
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("Categories", r.Table(Table.Category).GetAll(webLogId).OptArg("index", "WebLogId").Count()))
.RunResultAsync<DashboardCounts> conn
}
|> Async.RunSynchronously

2
src/MyWebLog.Logic/Page.fs
View File

@ -19,7 +19,7 @@ let findAllPages (data : IMyWebLogData) webLogId = data.AllPages webLogId
/// Save a page
let savePage (data : IMyWebLogData) (page : Page) =
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
newPg.Id
| _ -> data.UpdatePage page