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:
parent
f4d520e34b
commit
e5700727e9
5
.gitignore
vendored
5
.gitignore
vendored
@ -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
|
||||||
|
@ -155,9 +155,10 @@ type Startup() =
|
|||||||
|
|
||||||
|
|
||||||
let Run () =
|
let Run () =
|
||||||
WebHostBuilder()
|
use host =
|
||||||
.UseContentRoot(System.IO.Directory.GetCurrentDirectory())
|
WebHostBuilder()
|
||||||
.UseKestrel()
|
.UseContentRoot(System.IO.Directory.GetCurrentDirectory())
|
||||||
.UseStartup<Startup>()
|
.UseKestrel()
|
||||||
.Build()
|
.UseStartup<Startup>()
|
||||||
.Run()
|
.Build()
|
||||||
|
host.Run()
|
||||||
|
@ -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,
|
||||||
|
@ -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 {
|
||||||
.GetAll(webLogId).OptArg("index", "WebLogId")
|
return! r.Table(Table.Category)
|
||||||
.OrderBy("Name")
|
.GetAll(webLogId).OptArg("index", "WebLogId")
|
||||||
.RunResultAsync<Category list>(conn)
|
.OrderBy("Name")
|
||||||
|> await
|
.RunResultAsync<Category list> conn
|
||||||
|
}
|
||||||
|
|> 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 {
|
||||||
.Insert(cat)
|
do! r.Table(Table.Category)
|
||||||
.RunResultAsync(conn) |> await |> ignore
|
.Insert(cat)
|
||||||
|
.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 {
|
||||||
.Update({ CategoryUpdateRecord.Name = cat.Name
|
do! (category cat.WebLogId cat.Id)
|
||||||
Slug = cat.Slug
|
.Update({ CategoryUpdateRecord.Name = cat.Name
|
||||||
Description = cat.Description
|
Slug = cat.Slug
|
||||||
ParentId = cat.ParentId })
|
Description = cat.Description
|
||||||
.RunResultAsync(conn) |> await |> ignore
|
ParentId = cat.ParentId
|
||||||
|
})
|
||||||
|
.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 {
|
||||||
.Update({ CategoryChildrenUpdateRecord.Children = children })
|
do! (category webLogId parentId)
|
||||||
.RunResultAsync(conn) |> await |> ignore
|
.Update({ CategoryChildrenUpdateRecord.Children = children })
|
||||||
|
.RunResultAsync conn
|
||||||
|
}
|
||||||
|
|> Async.RunSynchronously
|
||||||
|
|
||||||
type CategoryParentUpdateRecord =
|
type CategoryParentUpdateRecord =
|
||||||
{ ParentId : string option }
|
{ ParentId : string option }
|
||||||
@ -63,43 +76,59 @@ type PostCategoriesUpdateRecord =
|
|||||||
{ CategoryIds : string list }
|
{ CategoryIds : string list }
|
||||||
/// Delete a category
|
/// Delete a category
|
||||||
let deleteCategory conn (cat : Category) =
|
let deleteCategory conn (cat : Category) =
|
||||||
// Remove the category from its parent
|
async {
|
||||||
match cat.ParentId with
|
// Remove the category from its parent
|
||||||
| Some parentId -> match tryFindCategory conn cat.WebLogId parentId with
|
match cat.ParentId with
|
||||||
| Some parent -> parent.Children
|
| Some parentId -> match tryFindCategory conn cat.WebLogId parentId with
|
||||||
|> List.filter (fun childId -> childId <> cat.Id)
|
| Some parent -> parent.Children
|
||||||
|> updateChildren conn cat.WebLogId parentId
|
|> 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 }
|
// Move this category's children to its parent
|
||||||
cat.Children
|
let newParent = { CategoryParentUpdateRecord.ParentId = cat.ParentId }
|
||||||
|> List.iter (fun childId -> (category cat.WebLogId childId)
|
cat.Children
|
||||||
.Update(newParent)
|
|> List.map (fun childId ->
|
||||||
.RunResultAsync(conn) |> await |> ignore)
|
async {
|
||||||
// Remove the category from posts where it is assigned
|
do! (category cat.WebLogId childId)
|
||||||
r.Table(Table.Post)
|
.Update(newParent)
|
||||||
.GetAll(cat.WebLogId).OptArg("index", "WebLogId")
|
.RunResultAsync conn
|
||||||
.Filter(ReqlFunction1(fun p -> upcast p.["CategoryIds"].Contains(cat.Id)))
|
})
|
||||||
.RunResultAsync<Post list>(conn)
|
|> List.iter Async.RunSynchronously
|
||||||
|> await
|
// Remove the category from posts where it is assigned
|
||||||
|> List.iter (fun post -> let newCats =
|
let! posts =
|
||||||
{ PostCategoriesUpdateRecord.CategoryIds = post.CategoryIds
|
r.Table(Table.Post)
|
||||||
|> List.filter (fun c -> c <> cat.Id) }
|
.GetAll(cat.WebLogId).OptArg("index", "WebLogId")
|
||||||
r.Table(Table.Post)
|
.Filter(ReqlFunction1(fun p -> upcast p.["CategoryIds"].Contains(cat.Id)))
|
||||||
.Get(post.Id)
|
.RunResultAsync<Post list> conn
|
||||||
.Update(newCats)
|
|> Async.AwaitTask
|
||||||
.RunResultAsync(conn) |> await |> ignore)
|
posts
|
||||||
// Now, delete the category
|
|> List.map (fun post ->
|
||||||
r.Table(Table.Category)
|
async {
|
||||||
.Get(cat.Id)
|
let newCats =
|
||||||
.Delete()
|
{ PostCategoriesUpdateRecord.CategoryIds = post.CategoryIds
|
||||||
.RunResultAsync(conn) |> await |> ignore
|
|> 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
|
/// 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 {
|
||||||
.GetAll(r.Array(webLogId, slug)).OptArg("index", "Slug")
|
let! cat = r.Table(Table.Category)
|
||||||
.RunResultAsync<Category list>(conn)
|
.GetAll(r.Array(webLogId, slug)).OptArg("index", "Slug")
|
||||||
|> await
|
.RunResultAsync<Category list> conn
|
||||||
|> List.tryHead
|
return cat |> List.tryHead
|
||||||
|
}
|
||||||
|
|> Async.RunSynchronously
|
||||||
|
@ -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
|
@ -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
|
||||||
|
|
@ -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) =
|
||||||
logStep "|> Checking database"
|
async {
|
||||||
let dbs = r.DbList().RunResultAsync<string list>(cfg.Conn) |> await
|
logStep "|> Checking database"
|
||||||
match List.contains cfg.Database dbs with
|
let! dbs = r.DbList().RunResultAsync<string list> cfg.Conn
|
||||||
| true -> ()
|
match List.contains cfg.Database dbs with
|
||||||
| _ -> logStepStart (sprintf " %s database not found - creating" cfg.Database)
|
| true -> ()
|
||||||
r.DbCreate(cfg.Database).RunResultAsync(cfg.Conn) |> await |> ignore
|
| _ -> logStepStart (sprintf " %s database not found - creating" cfg.Database)
|
||||||
logStepDone ()
|
do! r.DbCreate(cfg.Database).RunResultAsync cfg.Conn
|
||||||
|
logStepDone ()
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
/// Ensure all required tables exist
|
/// Ensure all required tables exist
|
||||||
let private checkTables cfg =
|
let private checkTables cfg =
|
||||||
logStep "|> Checking tables"
|
async {
|
||||||
let tables = r.Db(cfg.Database).TableList().RunResultAsync<string list>(cfg.Conn) |> await
|
logStep "|> Checking tables"
|
||||||
[ Table.Category; Table.Comment; Table.Page; Table.Post; Table.User; Table.WebLog ]
|
let! tables = r.Db(cfg.Database).TableList().RunResultAsync<string list> cfg.Conn
|
||||||
|> List.filter (fun tbl -> not (List.contains tbl tables))
|
[ Table.Category; Table.Comment; Table.Page; Table.Post; Table.User; Table.WebLog ]
|
||||||
|> List.iter (fun tbl -> logStepStart (sprintf " Creating table %s" tbl)
|
|> List.filter (fun tbl -> not (List.contains tbl tables))
|
||||||
(r.TableCreate tbl).RunResultAsync(cfg.Conn) |> await |> ignore
|
|> List.iter (fun tbl -> logStepStart (sprintf " Creating table %s" tbl)
|
||||||
logStepDone ())
|
async { do! (r.TableCreate tbl).RunResultAsync cfg.Conn } |> Async.RunSynchronously
|
||||||
|
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) =
|
||||||
let idxName, idxFunc = index
|
async {
|
||||||
logStepStart (sprintf """ Creating index "%s" on table %s""" idxName table)
|
let idxName, idxFunc = index
|
||||||
(match idxFunc with
|
logStepStart (sprintf """ Creating index "%s" on table %s""" idxName table)
|
||||||
| Some f -> (tbl cfg table).IndexCreate(idxName, f)
|
do! (match idxFunc with
|
||||||
| None -> (tbl cfg table).IndexCreate(idxName))
|
| Some f -> (tbl cfg table).IndexCreate(idxName, f)
|
||||||
.RunResultAsync(cfg.Conn)
|
| None -> (tbl cfg table).IndexCreate(idxName))
|
||||||
|> await |> ignore
|
.RunResultAsync cfg.Conn
|
||||||
(tbl cfg table).IndexWait(idxName).RunResultAsync(cfg.Conn) |> await |> ignore
|
do! (tbl cfg table).IndexWait(idxName).RunResultAsync cfg.Conn
|
||||||
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 {
|
||||||
idxs
|
let! idx = (tbl cfg tblName).IndexList().RunResultAsync<string list> cfg.Conn
|
||||||
|> List.iter (fun index -> match List.contains (fst index) idx with true -> () | _ -> createIndex cfg tblName index)
|
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
|
indexes
|
||||||
|> List.iter ensureForTable
|
|> List.iter ensureForTable
|
||||||
|
|
||||||
@ -61,27 +72,30 @@ let private checkIndexes cfg =
|
|||||||
logStep "|> Checking indexes"
|
logStep "|> Checking indexes"
|
||||||
[ Table.Category, [ "WebLogId", None
|
[ Table.Category, [ "WebLogId", None
|
||||||
"Slug", webLogField "Slug"
|
"Slug", webLogField "Slug"
|
||||||
]
|
]
|
||||||
Table.Comment, [ "PostId", None
|
Table.Comment, [ "PostId", None
|
||||||
]
|
]
|
||||||
Table.Page, [ "WebLogId", None
|
Table.Page, [ "WebLogId", None
|
||||||
"Permalink", webLogField "Permalink"
|
"Permalink", webLogField "Permalink"
|
||||||
]
|
]
|
||||||
Table.Post, [ "WebLogId", None
|
Table.Post, [ "WebLogId", None
|
||||||
"WebLogAndStatus", webLogField "Status"
|
"WebLogAndStatus", webLogField "Status"
|
||||||
"Permalink", webLogField "Permalink"
|
"Permalink", webLogField "Permalink"
|
||||||
]
|
|
||||||
Table.User, [ "UserName", None
|
|
||||||
]
|
|
||||||
Table.WebLog, [ "UrlBase", None
|
|
||||||
]
|
]
|
||||||
]
|
Table.User, [ "UserName", None
|
||||||
|
]
|
||||||
|
Table.WebLog, [ "UrlBase", None
|
||||||
|
]
|
||||||
|
]
|
||||||
|> ensureIndexes cfg
|
|> ensureIndexes 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 =
|
||||||
logStep "Database Start Up Checks Starting"
|
async {
|
||||||
checkDatabase cfg
|
logStep "Database Start Up Checks Starting"
|
||||||
checkTables cfg
|
do! checkDatabase cfg
|
||||||
checkIndexes cfg
|
do! checkTables cfg
|
||||||
logStep "Database Start Up Checks Complete"
|
checkIndexes cfg
|
||||||
|
logStep "Database Start Up Checks Complete"
|
||||||
|
}
|
||||||
|
|> Async.RunSynchronously
|
||||||
|
@ -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) =
|
||||||
r.Table(Table.User)
|
async {
|
||||||
.GetAll(email).OptArg("index", "UserName")
|
let! user =
|
||||||
.Filter(ReqlFunction1(fun u -> upcast u.["PasswordHash"].Eq(passwordHash)))
|
r.Table(Table.User)
|
||||||
.RunResultAsync<User list>(conn)
|
.GetAll(email).OptArg("index", "UserName")
|
||||||
|> await
|
.Filter(ReqlFunction1(fun u -> upcast u.["PasswordHash"].Eq(passwordHash)))
|
||||||
|> List.tryHead
|
.RunResultAsync<User list> conn
|
||||||
|
return user |> List.tryHead
|
||||||
|
}
|
||||||
|
|> Async.RunSynchronously
|
||||||
|
@ -7,24 +7,30 @@ 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) =
|
||||||
r.Table(Table.WebLog)
|
async {
|
||||||
.GetAll(urlBase).OptArg("index", "UrlBase")
|
let! cursor =
|
||||||
.Merge(ReqlFunction1(fun w ->
|
r.Table(Table.WebLog)
|
||||||
upcast r.HashMap("PageList", r.Table(Table.Page)
|
.GetAll(urlBase).OptArg("index", "UrlBase")
|
||||||
.GetAll(w.G("id")).OptArg("index", "WebLogId")
|
.Merge(ReqlFunction1(fun w ->
|
||||||
.Filter(ReqlFunction1(fun pg -> upcast pg.["ShowInPageList"].Eq(true)))
|
upcast r.HashMap("PageList", r.Table(Table.Page)
|
||||||
.OrderBy("Title")
|
.GetAll(w.G("id")).OptArg("index", "WebLogId")
|
||||||
.Pluck("Title", "Permalink")
|
.Filter(ReqlFunction1(fun pg -> upcast pg.["ShowInPageList"].Eq(true)))
|
||||||
.CoerceTo("array"))))
|
.OrderBy("Title")
|
||||||
.RunResultAsync<WebLog list>(conn)
|
.Pluck("Title", "Permalink")
|
||||||
|> await
|
.CoerceTo("array"))))
|
||||||
|> List.tryHead
|
.RunCursorAsync<WebLog> conn
|
||||||
|
return cursor |> Seq.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) =
|
||||||
r.Expr( r.HashMap("Pages", r.Table(Table.Page ).GetAll(webLogId).OptArg("index", "WebLogId").Count()))
|
async {
|
||||||
.Merge(r.HashMap("Posts", r.Table(Table.Post ).GetAll(webLogId).OptArg("index", "WebLogId").Count()))
|
return!
|
||||||
.Merge(r.HashMap("Categories", r.Table(Table.Category).GetAll(webLogId).OptArg("index", "WebLogId").Count()))
|
r.Expr( r.HashMap("Pages", r.Table(Table.Page ).GetAll(webLogId).OptArg("index", "WebLogId").Count()))
|
||||||
.RunResultAsync<DashboardCounts>(conn)
|
.Merge(r.HashMap("Posts", r.Table(Table.Post ).GetAll(webLogId).OptArg("index", "WebLogId").Count()))
|
||||||
|> await
|
.Merge(r.HashMap("Categories", r.Table(Table.Category).GetAll(webLogId).OptArg("index", "WebLogId").Count()))
|
||||||
|
.RunResultAsync<DashboardCounts> conn
|
||||||
|
}
|
||||||
|
|> Async.RunSynchronously
|
||||||
|
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user