From e5700727e952be5f53ee824fec21db1e0ad6d1bc Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Mon, 7 Nov 2016 22:17:00 -0600 Subject: [PATCH] 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 --- .gitignore | 5 + src/MyWebLog.App/App.fs | 13 +- src/MyWebLog.App/PostModule.fs | 50 +++++- src/MyWebLog.Data.RethinkDB/Category.fs | 149 +++++++++++------- src/MyWebLog.Data.RethinkDB/Extensions.fs | 15 +- .../RethinkMyWebLogData.fs | 66 ++++---- src/MyWebLog.Data.RethinkDB/SetUp.fs | 94 ++++++----- src/MyWebLog.Data.RethinkDB/User.fs | 15 +- src/MyWebLog.Data.RethinkDB/WebLog.fs | 40 +++-- src/MyWebLog.Logic/Page.fs | 2 +- 10 files changed, 281 insertions(+), 168 deletions(-) diff --git a/.gitignore b/.gitignore index 4fa91e2..51a0960 100644 --- a/.gitignore +++ b/.gitignore @@ -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 diff --git a/src/MyWebLog.App/App.fs b/src/MyWebLog.App/App.fs index c3e451f..c22de60 100644 --- a/src/MyWebLog.App/App.fs +++ b/src/MyWebLog.App/App.fs @@ -155,9 +155,10 @@ type Startup() = let Run () = - WebHostBuilder() - .UseContentRoot(System.IO.Directory.GetCurrentDirectory()) - .UseKestrel() - .UseStartup() - .Build() - .Run() + use host = + WebHostBuilder() + .UseContentRoot(System.IO.Directory.GetCurrentDirectory()) + .UseKestrel() + .UseStartup() + .Build() + host.Run() diff --git a/src/MyWebLog.App/PostModule.fs b/src/MyWebLog.App/PostModule.fs index c28a469..98f046d 100644 --- a/src/MyWebLog.App/PostModule.fs +++ b/src/MyWebLog.App/PostModule.fs @@ -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, diff --git a/src/MyWebLog.Data.RethinkDB/Category.fs b/src/MyWebLog.Data.RethinkDB/Category.fs index 226922a..9b3cc32 100644 --- a/src/MyWebLog.Data.RethinkDB/Category.fs +++ b/src/MyWebLog.Data.RethinkDB/Category.fs @@ -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(conn) - |> await + async { + return! r.Table(Table.Category) + .GetAll(webLogId).OptArg("index", "WebLogId") + .OrderBy("Name") + .RunResultAsync conn + } + |> Async.RunSynchronously /// Get a specific category by its Id let tryFindCategory conn webLogId catId : Category option = - (category webLogId catId) - .RunResultAsync(conn) - |> await - |> box - |> function null -> None | cat -> Some <| unbox cat + async { + let! catt = (category webLogId catId).RunResultAsync 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(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 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(conn) - |> await - |> List.tryHead + async { + let! cat = r.Table(Table.Category) + .GetAll(r.Array(webLogId, slug)).OptArg("index", "Slug") + .RunResultAsync conn + return cat |> List.tryHead + } + |> Async.RunSynchronously diff --git a/src/MyWebLog.Data.RethinkDB/Extensions.fs b/src/MyWebLog.Data.RethinkDB/Extensions.fs index 0582f5d..d0bf11c 100644 --- a/src/MyWebLog.Data.RethinkDB/Extensions.fs +++ b/src/MyWebLog.Data.RethinkDB/Extensions.fs @@ -1,7 +1,18 @@ [] 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 \ No newline at end of file diff --git a/src/MyWebLog.Data.RethinkDB/RethinkMyWebLogData.fs b/src/MyWebLog.Data.RethinkDB/RethinkMyWebLogData.fs index a310399..04e0e26 100644 --- a/src/MyWebLog.Data.RethinkDB/RethinkMyWebLogData.fs +++ b/src/MyWebLog.Data.RethinkDB/RethinkMyWebLogData.fs @@ -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 \ No newline at end of file diff --git a/src/MyWebLog.Data.RethinkDB/SetUp.fs b/src/MyWebLog.Data.RethinkDB/SetUp.fs index e9296ba..347a488 100644 --- a/src/MyWebLog.Data.RethinkDB/SetUp.fs +++ b/src/MyWebLog.Data.RethinkDB/SetUp.fs @@ -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(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 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(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 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(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 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 diff --git a/src/MyWebLog.Data.RethinkDB/User.fs b/src/MyWebLog.Data.RethinkDB/User.fs index 5d34b58..fd3ed48 100644 --- a/src/MyWebLog.Data.RethinkDB/User.fs +++ b/src/MyWebLog.Data.RethinkDB/User.fs @@ -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(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 conn + return user |> List.tryHead + } + |> Async.RunSynchronously diff --git a/src/MyWebLog.Data.RethinkDB/WebLog.fs b/src/MyWebLog.Data.RethinkDB/WebLog.fs index 0fcd7d0..34a29c0 100644 --- a/src/MyWebLog.Data.RethinkDB/WebLog.fs +++ b/src/MyWebLog.Data.RethinkDB/WebLog.fs @@ -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(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 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(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 conn + } + |> Async.RunSynchronously \ No newline at end of file diff --git a/src/MyWebLog.Logic/Page.fs b/src/MyWebLog.Logic/Page.fs index 5c6bb8c..81fb0f4 100644 --- a/src/MyWebLog.Logic/Page.fs +++ b/src/MyWebLog.Logic/Page.fs @@ -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