diff --git a/src/myWebLog.Data/Category.fs b/src/myWebLog.Data/Category.fs index e9e3540..fd9ebd3 100644 --- a/src/myWebLog.Data/Category.fs +++ b/src/myWebLog.Data/Category.fs @@ -5,11 +5,13 @@ open myWebLog.Entities open Rethink open System.Dynamic +let private r = RethinkDb.Driver.RethinkDB.R + /// Shorthand to get a category by Id and filter by web log Id -let private category webLogId catId = - table Table.Category - |> get catId - |> filter (fun c -> upcast c.["webLogId"].Eq(webLogId)) +let private category (webLogId : string) (catId : string) = + r.Table(Table.Category) + .Get(catId) + .Filter(fun c -> c.["webLogId"].Eq(webLogId)) /// Sort categories by their name, with their children sorted below them, including an indent level let sortCategories categories = @@ -26,28 +28,26 @@ let sortCategories categories = |> Seq.toList /// Get all categories for a web log -let getAllCategories conn webLogId = - table Table.Category - |> getAll [| webLogId |] - |> optArg "index" "webLogId" - |> orderBy (fun c -> upcast c.["name"]) - |> runCursorAsync conn +let getAllCategories conn (webLogId : string) = + r.Table(Table.Category) + .GetAll(webLogId).OptArg("index", "webLogId") + .OrderBy("name") + .RunCursorAsync(conn) + |> await |> Seq.toList |> sortCategories /// Count categories for a web log -let countCategories conn webLogId = - table Table.Category - |> getAll [| webLogId |] - |> optArg "index" "webLogId" - |> count - |> runAtomAsync conn +let countCategories conn (webLogId : string) = + r.Table(Table.Category) + .GetAll(webLogId).OptArg("index", "webLogId") + .Count() + .RunAtomAsync(conn) |> await /// Get a specific category by its Id let tryFindCategory conn webLogId catId : Category option = - match category webLogId catId - |> runAtomAsync conn - |> box with + match (category webLogId catId) + .RunAtomAsync(conn) |> await |> box with | null -> None | cat -> Some <| unbox cat @@ -56,20 +56,18 @@ let saveCategory conn webLogId (cat : Category) = match cat.id with | "new" -> let newCat = { cat with id = string <| System.Guid.NewGuid() webLogId = webLogId } - table Table.Category - |> insert newCat - |> runResultAsync conn - |> ignore + r.Table(Table.Category) + .Insert(newCat) + .RunResultAsync(conn) |> await |> ignore newCat.id | _ -> let upd8 = ExpandoObject() upd8?name <- cat.name upd8?slug <- cat.slug upd8?description <- cat.description upd8?parentId <- cat.parentId - category webLogId cat.id - |> update upd8 - |> runResultAsync conn - |> ignore + (category webLogId cat.id) + .Update(upd8) + .RunResultAsync(conn) |> await |> ignore cat.id /// Remove a category from a given parent @@ -77,11 +75,10 @@ let removeCategoryFromParent conn webLogId parentId catId = match tryFindCategory conn webLogId parentId with | Some parent -> let upd8 = ExpandoObject() upd8?children <- parent.children - |> List.filter (fun ch -> ch <> catId) - category webLogId parentId - |> update upd8 - |> runResultAsync conn - |> ignore + |> List.filter (fun childId -> childId <> catId) + (category webLogId parentId) + .Update(upd8) + .RunResultAsync(conn) |> await |> ignore | None -> () /// Add a category to a given parent @@ -89,10 +86,9 @@ let addCategoryToParent conn webLogId parentId catId = match tryFindCategory conn webLogId parentId with | Some parent -> let upd8 = ExpandoObject() upd8?children <- catId :: parent.children - category webLogId parentId - |> update upd8 - |> runResultAsync conn - |> ignore + (category webLogId parentId) + .Update(upd8) + .RunResultAsync(conn) |> await |> ignore | None -> () /// Delete a category @@ -105,37 +101,33 @@ let deleteCategory conn cat = let newParent = ExpandoObject() newParent?parentId <- cat.parentId cat.children - |> List.iter (fun childId -> category cat.webLogId childId - |> update newParent - |> runResultAsync conn - |> ignore) + |> List.iter (fun childId -> (category cat.webLogId childId) + .Update(newParent) + .RunResultAsync(conn) |> await |> ignore) // Remove the category from posts where it is assigned - table Table.Post - |> getAll [| cat.webLogId |] - |> optArg "index" "webLogId" - |> filter (fun p -> upcast p.["categoryIds"].Contains(cat.id)) - |> runCursorAsync conn + r.Table(Table.Post) + .GetAll(cat.webLogId).OptArg("index", "webLogId") + .Filter(fun p -> p.["categoryIds"].Contains(cat.id)) + .RunCursorAsync(conn) + |> await |> Seq.toList |> List.iter (fun post -> let newCats = ExpandoObject() newCats?categoryIds <- post.categoryIds |> List.filter (fun c -> c <> cat.id) - table Table.Post - |> get post.id - |> update newCats - |> runResultAsync conn - |> ignore) + r.Table(Table.Post) + .Get(post.id) + .Update(newCats) + .RunResultAsync(conn) |> await |> ignore) // Now, delete the category - table Table.Category - |> get cat.id - |> delete - |> runResultAsync conn - |> ignore + r.Table(Table.Category) + .Get(cat.id) + .Delete() + .RunResultAsync(conn) |> await |> ignore /// Get a category by its slug -let tryFindCategoryBySlug conn webLogId slug = - table Table.Category - |> getAll [| slug |] - |> optArg "index" "slug" - |> filter (fun c -> upcast c.["webLogId"].Eq(webLogId)) - |> runCursorAsync conn +let tryFindCategoryBySlug conn (webLogId : string) (slug : string) = + r.Table(Table.Category) + .GetAll(webLogId, slug).OptArg("index", "slug") + .RunCursorAsync(conn) + |> await |> Seq.tryHead diff --git a/src/myWebLog.Data/Page.fs b/src/myWebLog.Data/Page.fs index fe3908f..8b31e56 100644 --- a/src/myWebLog.Data/Page.fs +++ b/src/myWebLog.Data/Page.fs @@ -5,63 +5,62 @@ open myWebLog.Entities open Rethink open System.Dynamic +let private r = RethinkDb.Driver.RethinkDB.R + /// Shorthand to get the page by its Id, filtering on web log Id -let private page webLogId pageId = - table Table.Page - |> get pageId - |> filter (fun p -> upcast p.["webLogId"].Eq(webLogId)) +let private page (webLogId : string) (pageId : string) = + r.Table(Table.Page) + .Get(pageId) + .Filter(fun p -> p.["webLogId"].Eq(webLogId)) /// Get a page by its Id let tryFindPage conn webLogId pageId : Page option = - match page webLogId pageId - |> runAtomAsync conn - |> box with + match (page webLogId pageId) + .RunAtomAsync(conn) |> await |> box with | null -> None | page -> Some <| unbox page /// Get a page by its Id (excluding revisions) let tryFindPageWithoutRevisions conn webLogId pageId : Page option = - match page webLogId pageId - |> without [| "revisions" |] - |> runAtomAsync conn - |> box with + match (page webLogId pageId) + .Without("revisions") + .RunAtomAsync(conn) |> await |> box with | null -> None | page -> Some <| unbox page /// Find a page by its permalink -let tryFindPageByPermalink conn webLogId permalink = - table Table.Page - |> getAll [| webLogId; permalink |] - |> optArg "index" "permalink" - |> without [| "revisions" |] - |> runCursorAsync conn +let tryFindPageByPermalink conn (webLogId : string) (permalink : string) = + r.Table(Table.Page) + .GetAll(webLogId, permalink).OptArg("index", "permalink") + .Without("revisions") + .RunCursorAsync(conn) + |> await |> Seq.tryHead /// Count pages for a web log -let countPages conn webLogId = - table Table.Page - |> getAll [| webLogId |] - |> optArg "index" "webLogId" - |> count - |> runAtomAsync conn +let countPages conn (webLogId : string) = + r.Table(Table.Page) + .GetAll(webLogId).OptArg("index", "webLogId") + .Count() + .RunAtomAsync(conn) |> await /// Get a list of all pages (excludes page text and revisions) -let findAllPages conn webLogId = - table Table.Page - |> getAll [| webLogId |] - |> orderBy (fun p -> upcast p.["title"]) - |> without [| "text"; "revisions" |] - |> runCursorAsync conn +let findAllPages conn (webLogId : string) = + r.Table(Table.Page) + .GetAll(webLogId) + .OrderBy("title") + .Without("text", "revisions") + .RunCursorAsync(conn) + |> await |> Seq.toList /// Save a page let savePage conn (pg : Page) = match pg.id with | "new" -> let newPage = { pg with id = string <| System.Guid.NewGuid() } - table Table.Page - |> insert page - |> runResultAsync conn - |> ignore + r.Table(Table.Page) + .Insert(page) + .RunResultAsync(conn) |> await |> ignore newPage.id | _ -> let upd8 = ExpandoObject() upd8?title <- pg.title @@ -70,15 +69,13 @@ let savePage conn (pg : Page) = upd8?updatedOn <- pg.updatedOn upd8?text <- pg.text upd8?revisions <- pg.revisions - page pg.webLogId pg.id - |> update upd8 - |> runResultAsync conn - |> ignore + (page pg.webLogId pg.id) + .Update(upd8) + .RunResultAsync(conn) |> await |> ignore pg.id /// Delete a page let deletePage conn webLogId pageId = - page webLogId pageId - |> delete - |> runResultAsync conn - |> ignore + (page webLogId pageId) + .Delete() + .RunResultAsync(conn) |> await |> ignore diff --git a/src/myWebLog.Data/Post.fs b/src/myWebLog.Data/Post.fs index 829b10b..e64c73a 100644 --- a/src/myWebLog.Data/Post.fs +++ b/src/myWebLog.Data/Post.fs @@ -3,36 +3,43 @@ open FSharp.Interop.Dynamic open myWebLog.Entities open Rethink -open RethinkDb.Driver open RethinkDb.Driver.Ast open System.Dynamic -let private r = RethinkDB.R +let private r = RethinkDb.Driver.RethinkDB.R /// Shorthand to select all published posts for a web log -let private publishedPosts webLogId = - table Table.Post - |> getAll [| webLogId; PostStatus.Published |] - |> optArg "index" "webLogAndStatus" +let private publishedPosts (webLogId : string)= + r.Table(Table.Post) + .GetAll(r.Array(webLogId, PostStatus.Published)).OptArg("index", "webLogAndStatus") /// Shorthand to sort posts by published date, slice for the given page, and return a list -let private toPostList conn pageNbr nbrPerPage filter = +let private toPostList conn pageNbr nbrPerPage (filter : ReqlExpr) = filter - |> orderBy (fun p -> upcast r.Desc(p.["publishedOn"])) - |> slice ((pageNbr - 1) * nbrPerPage) (pageNbr * nbrPerPage) - |> runAtomAsync> conn + .OrderBy(r.Desc("publishedOn")) + .Slice((pageNbr - 1) * nbrPerPage, pageNbr * nbrPerPage) + .RunListAsync(conn) + |> await |> Seq.toList /// Shorthand to get a newer or older post -let private adjacentPost conn post theFilter = - System.Console.WriteLine "Adjacent post" - publishedPosts post.webLogId - |> filter theFilter - |> orderBy (fun p -> upcast p.["publishedOn"]) - |> limit 1 - |> runCursorAsync conn +// TODO: older posts need to sort by published on DESC +//let private adjacentPost conn post (theFilter : ReqlExpr -> ReqlExpr) (sort :ReqlExpr) : Post option = +let private adjacentPost conn post (theFilter : obj) (sort : obj) : Post option = + (publishedPosts post.webLogId) + .Filter(theFilter) + .OrderBy(sort) + .Limit(1) + .RunListAsync(conn) + |> await |> Seq.tryHead +/// Find a newer post +let private newerPost conn post theFilter = adjacentPost conn post theFilter <| r.Asc "publishedOn" + +/// Find an older post +let private olderPost conn post theFilter = adjacentPost conn post theFilter <| r.Desc "publishedOn" + /// Get a page of published posts let findPageOfPublishedPosts conn webLogId pageNbr nbrPerPage = publishedPosts webLogId @@ -40,109 +47,109 @@ let findPageOfPublishedPosts conn webLogId pageNbr nbrPerPage = /// Get a page of published posts assigned to a given category let findPageOfCategorizedPosts conn webLogId (categoryId : string) pageNbr nbrPerPage = - publishedPosts webLogId - |> filter (fun p -> upcast p.["categoryIds"].Contains(categoryId)) + (publishedPosts webLogId) + .Filter(fun p -> p.["categoryIds"].Contains(categoryId)) |> toPostList conn pageNbr nbrPerPage /// Get a page of published posts tagged with a given tag let findPageOfTaggedPosts conn webLogId (tag : string) pageNbr nbrPerPage = - publishedPosts webLogId - |> filter (fun p -> upcast p.["tags"].Contains(tag)) + (publishedPosts webLogId) + .Filter(fun p -> p.["tags"].Contains(tag)) |> toPostList conn pageNbr nbrPerPage /// Try to get the next newest post from the given post -let tryFindNewerPost conn post = adjacentPost conn post (fun p -> upcast p.["publishedOn"].Gt(post.publishedOn)) +let tryFindNewerPost conn post = newerPost conn post (fun p -> (p :> ReqlExpr).["publishedOn"].Gt(post.publishedOn)) /// Try to get the next newest post assigned to the given category let tryFindNewerCategorizedPost conn (categoryId : string) post = - adjacentPost conn post - (fun p -> upcast p.["publishedOn"].Gt(post.publishedOn).And(p.["categoryIds"].Contains(categoryId))) + newerPost conn post (fun p -> (p :> ReqlExpr).["publishedOn"].Gt(post.publishedOn) + .And(p.["categoryIds"].Contains(categoryId))) /// Try to get the next newest tagged post from the given tagged post let tryFindNewerTaggedPost conn (tag : string) post = - adjacentPost conn post (fun p -> upcast p.["publishedOn"].Gt(post.publishedOn).And(p.["tags"].Contains(tag))) + newerPost conn post (fun p -> (p :> ReqlExpr).["publishedOn"].Gt(post.publishedOn).And(p.["tags"].Contains(tag))) /// Try to get the next oldest post from the given post -let tryFindOlderPost conn post = adjacentPost conn post (fun p -> upcast p.["publishedOn"].Lt(post.publishedOn)) +let tryFindOlderPost conn post = olderPost conn post (fun p -> (p :> ReqlExpr).["publishedOn"].Lt(post.publishedOn)) /// Try to get the next oldest post assigned to the given category let tryFindOlderCategorizedPost conn (categoryId : string) post = - adjacentPost conn post - (fun p -> upcast p.["publishedOn"].Lt(post.publishedOn).And(p.["categoryIds"].Contains(categoryId))) + olderPost conn post (fun p -> (p :> ReqlExpr).["publishedOn"].Lt(post.publishedOn) + .And(p.["categoryIds"].Contains(categoryId))) /// Try to get the next oldest tagged post from the given tagged post let tryFindOlderTaggedPost conn (tag : string) post = - adjacentPost conn post (fun p -> upcast p.["publishedOn"].Lt(post.publishedOn).And(p.["tags"].Contains(tag))) + olderPost conn post (fun p -> (p :> ReqlExpr).["publishedOn"].Lt(post.publishedOn).And(p.["tags"].Contains(tag))) /// Get a page of all posts in all statuses -let findPageOfAllPosts conn webLogId pageNbr nbrPerPage = - table Table.Post - |> getAll [| webLogId |] - |> optArg "index" "webLogId" - |> orderBy (fun p -> upcast r.Desc(r.Branch(p.["publishedOn"].Eq(int64 0), p.["lastUpdatedOn"], p.["publishedOn"]))) - |> slice ((pageNbr - 1) * nbrPerPage) (pageNbr * nbrPerPage) - |> runCursorAsync conn +let findPageOfAllPosts conn (webLogId : string) pageNbr nbrPerPage = + r.Table(Table.Post) + .GetAll(webLogId).OptArg("index", "webLogId") + .OrderBy(fun p -> r.Desc(r.Branch(p.["publishedOn"].Eq(int64 0), p.["lastUpdatedOn"], p.["publishedOn"]))) + .Slice((pageNbr - 1) * nbrPerPage, pageNbr * nbrPerPage) + .RunCursorAsync(conn) + |> await |> Seq.toList /// Try to find a post by its Id and web log Id let tryFindPost conn webLogId postId : Post option = - match table Table.Post - |> get postId - |> filter (fun p -> upcast p.["webLogId"].Eq(webLogId)) - |> runAtomAsync conn + match r.Table(Table.Post) + .Get(postId) + .Filter(fun p -> p.["webLogId"].Eq(webLogId)) + .RunAtomAsync(conn) |> box with | null -> None | post -> Some <| unbox post /// Try to find a post by its permalink let tryFindPostByPermalink conn webLogId permalink = - (table Table.Post - |> getAll [| webLogId; permalink |] - |> optArg "index" "permalink" - |> filter (fun p -> upcast p.["status"].Eq(PostStatus.Published)) - |> without [| "revisions" |]) - .Merge(fun post -> ExpandoObject()?categories <- - post.["categoryIds"] - .Map(ReqlFunction1(fun cat -> upcast r.Table(Table.Category).Get(cat).Without("children"))) - .CoerceTo("array")) - .Merge(fun post -> ExpandoObject()?comments <- - r.Table(Table.Comment) - .GetAll(post.["id"]).OptArg("index", "postId") - .OrderBy("postedOn") - .CoerceTo("array")) - |> runCursorAsync conn + r.Table(Table.Post) + .GetAll(r.Array(webLogId, permalink)).OptArg("index", "permalink") + .Filter(fun p -> p.["status"].Eq(PostStatus.Published)) + .Without("revisions") + .Merge(fun post -> ExpandoObject()?categories <- + post.["categoryIds"] + .Map(ReqlFunction1(fun cat -> upcast r.Table(Table.Category).Get(cat).Without("children"))) + .CoerceTo("array")) + .Merge(fun post -> ExpandoObject()?comments <- + r.Table(Table.Comment) + .GetAll(post.["id"]).OptArg("index", "postId") + .OrderBy("postedOn") + .CoerceTo("array")) + .RunCursorAsync(conn) + |> await |> Seq.tryHead /// Try to find a post by its prior permalink -let tryFindPostByPriorPermalink conn webLogId (permalink : string) = - table Table.Post - |> getAll [| webLogId |] - |> optArg "index" "webLogId" - |> filter (fun p -> upcast p.["priorPermalinks"].Contains(permalink).And(p.["status"].Eq(PostStatus.Published))) - |> without [| "revisions" |] - |> runCursorAsync conn +let tryFindPostByPriorPermalink conn (webLogId : string) (permalink : string) = + r.Table(Table.Post) + .GetAll(webLogId).OptArg("index", "webLogId") + .Filter(fun p -> p.["priorPermalinks"].Contains(permalink).And(p.["status"].Eq(PostStatus.Published))) + .Without("revisions") + .RunCursorAsync(conn) + |> await |> Seq.tryHead /// Save a post let savePost conn post = match post.id with | "new" -> let newPost = { post with id = string <| System.Guid.NewGuid() } - table Table.Post - |> insert newPost - |> runResultAsync conn + r.Table(Table.Post) + .Insert(newPost) + .RunResultAsync(conn) |> ignore newPost.id - | _ -> table Table.Post - |> get post.id - |> replace post - |> runResultAsync conn + | _ -> r.Table(Table.Post) + .Get(post.id) + .Replace(post) + .RunResultAsync(conn) |> ignore post.id /// Count posts for a web log -let countPosts conn webLogId = - table Table.Post - |> getAll [| webLogId |] - |> optArg "index" "webLogId" - |> count - |> runAtomAsync conn +let countPosts conn (webLogId : string) = + r.Table(Table.Post) + .GetAll(webLogId).OptArg("index", "webLogId") + .Count() + .RunAtomAsync(conn) + |> await diff --git a/src/myWebLog.Data/Rethink.fs b/src/myWebLog.Data/Rethink.fs index 5244836..1abb517 100644 --- a/src/myWebLog.Data/Rethink.fs +++ b/src/myWebLog.Data/Rethink.fs @@ -3,25 +3,8 @@ open RethinkDb.Driver.Ast open RethinkDb.Driver.Net -let private r = RethinkDb.Driver.RethinkDB.R -let private await task = task |> Async.AwaitTask |> Async.RunSynchronously +let await task = task |> Async.AwaitTask |> Async.RunSynchronously -let count (expr : ReqlExpr) = expr.Count () -let delete (expr : ReqlExpr) = expr.Delete () -let filter (expr : ReqlExpr -> ReqlExpr) (table : ReqlExpr) = table.Filter expr -let get (expr : obj) (table : Table) = table.Get expr -let getAll (exprs : obj[]) (table : Table) = table.GetAll exprs -let insert (expr : obj) (table : Table) = table.Insert expr -let limit (expr : obj) (table : ReqlExpr) = table.Limit expr -let optArg key (value : obj) (expr : GetAll) = expr.OptArg (key, value) -let orderBy (exprA : ReqlExpr -> ReqlExpr) (expr : ReqlExpr) = expr.OrderBy exprA -let replace (exprA : obj) (expr : Get) = expr.Replace exprA -let runAtomAsync<'T> (conn : IConnection) (ast : ReqlAst) = ast.RunAtomAsync<'T> conn |> await -let runCursorAsync<'T> (conn : IConnection) (ast : ReqlAst) = ast.RunCursorAsync<'T> conn |> await -let runListAsync<'T> (conn : IConnection) (ast : ReqlAst) = ast.RunAtomAsync> conn - |> await -let runResultAsync (conn : IConnection) (ast : ReqlAst) = ast.RunResultAsync conn |> await -let slice (exprA : obj) (exprB : obj) (ast : ReqlExpr) = ast.Slice (exprA, exprB) -let table (expr : obj) = r.Table expr -let update (exprA : obj) (expr : ReqlExpr) = expr.Update exprA -let without (exprs : obj[]) (expr : ReqlExpr) = expr.Without exprs \ No newline at end of file +type ReqlExpr with + /// Run a SUCCESS_ATOM response that returns multiple values + member this.RunListAsync<'T> (conn : IConnection) = this.RunAtomAsync> conn diff --git a/src/myWebLog.Data/SetUp.fs b/src/myWebLog.Data/SetUp.fs index c029578..8c6d8b5 100644 --- a/src/myWebLog.Data/SetUp.fs +++ b/src/myWebLog.Data/SetUp.fs @@ -1,31 +1,28 @@ module myWebLog.Data.SetUp -open RethinkDb.Driver -open System open Rethink open RethinkDb.Driver.Ast +open System -let private r = RethinkDB.R +let private r = RethinkDb.Driver.RethinkDB.R let private logStep step = Console.Out.WriteLine (sprintf "[myWebLog] %s" step) let private logStepStart text = Console.Out.Write (sprintf "[myWebLog] %s..." text) let private logStepDone () = Console.Out.WriteLine (" done.") -let private result task = task |> Async.AwaitTask |> Async.RunSynchronously - /// Ensure the myWebLog database exists let checkDatabase (cfg : DataConfig) = logStep "|> Checking database" - let dbs = r.DbList() |> runListAsync cfg.conn + let dbs = r.DbList().RunListAsync(cfg.conn) |> await match dbs.Contains cfg.database with | true -> () | _ -> logStepStart (sprintf " %s database not found - creating" cfg.database) - r.DbCreate cfg.database |> runResultAsync cfg.conn |> ignore + r.DbCreate(cfg.database).RunResultAsync(cfg.conn) |> await |> ignore logStepDone () /// Ensure all required tables exist let checkTables cfg = logStep "|> Checking tables" - let tables = r.Db(cfg.database).TableList() |> runListAsync cfg.conn + let tables = r.Db(cfg.database).TableList().RunListAsync(cfg.conn) |> await [ Table.Category; Table.Comment; Table.Page; Table.Post; Table.User; Table.WebLog ] |> List.map (fun tbl -> match tables.Contains tbl with | true -> None @@ -33,33 +30,33 @@ let checkTables cfg = |> List.filter (fun create -> create.IsSome) |> List.map (fun create -> create.Value) |> List.iter (fun (tbl, create) -> logStepStart (sprintf " Creating table %s" tbl) - create |> runResultAsync cfg.conn |> ignore + create.RunResultAsync(cfg.conn) |> await |> ignore logStepDone ()) /// Shorthand to get the table let tbl cfg table = r.Db(cfg.database).Table(table) /// Create the given index -let createIndex cfg table (index : string * (ReqlExpr -> obj)) = +let createIndex cfg table (index : string * obj) = logStepStart (sprintf """ Creating index "%s" on table %s""" (fst index) table) - (tbl cfg table).IndexCreate (fst index, snd index) |> runResultAsync cfg.conn |> ignore - (tbl cfg table).IndexWait (fst index) |> runAtomAsync cfg.conn |> ignore + (tbl cfg table).IndexCreate(fst index, snd index).RunResultAsync(cfg.conn) |> await |> ignore + (tbl cfg table).IndexWait(fst index).RunAtomAsync(cfg.conn) |> await |> ignore logStepDone () /// Ensure that the given indexes exist, and create them if required -let ensureIndexes cfg (indexes : (string * (string * (ReqlExpr -> obj)) list) list) = +let ensureIndexes cfg (indexes : (string * (string * obj) list) list) = indexes - |> List.iter (fun tabl -> let idx = (tbl cfg (fst tabl)).IndexList() |> runListAsync cfg.conn + |> List.iter (fun tabl -> let idx = (tbl cfg (fst tabl)).IndexList().RunListAsync(cfg.conn) |> await snd tabl |> List.iter (fun index -> match idx.Contains (fst index) with | true -> () | _ -> createIndex cfg (fst tabl) index)) /// Create an index on a single field -let singleField (name : string) : ReqlExpr -> obj = fun row -> upcast row.[name] +let singleField (name : string) : obj = upcast (fun row -> (row :> ReqlExpr).[name]) /// Create an index on web log Id and the given field -let webLogField (name : string) : ReqlExpr -> obj = fun row -> upcast r.Array(row.["webLogId"], row.[name]) +let webLogField (name : string) : obj = upcast (fun row -> r.Array((row :> ReqlExpr).["webLogId"], row.[name])) /// Ensure all the required indexes exist let checkIndexes cfg = @@ -77,7 +74,7 @@ let checkIndexes cfg = "webLogAndStatus", webLogField "status" "permalink", webLogField "permalink" ] - Table.User, [ "logOn", fun row -> upcast r.Array(row.["userName"], row.["passwordHash"]) + Table.User, [ "logOn", upcast (fun row -> r.Array((row :> ReqlExpr).["userName"], row.["passwordHash"])) ] Table.WebLog, [ "urlBase", singleField "urlBase" ] diff --git a/src/myWebLog.Data/User.fs b/src/myWebLog.Data/User.fs index c45bb4c..d618f49 100644 --- a/src/myWebLog.Data/User.fs +++ b/src/myWebLog.Data/User.fs @@ -3,10 +3,13 @@ open myWebLog.Entities open Rethink +let private r = RethinkDb.Driver.RethinkDB.R + /// Log on a user -let tryUserLogOn conn email passwordHash = - table Table.User - |> getAll [| email, passwordHash |] - |> optArg "index" "logOn" - |> runCursorAsync conn +// FIXME: the password hash may be longer than the significant size of a RethinkDB index +let tryUserLogOn conn (email : string) (passwordHash : string) = + r.Table(Table.User) + .GetAll(email, passwordHash).OptArg("index", "logOn") + .RunCursorAsync(conn) + |> await |> Seq.tryHead diff --git a/src/myWebLog.Data/WebLog.fs b/src/myWebLog.Data/WebLog.fs index a0c967b..57d8c35 100644 --- a/src/myWebLog.Data/WebLog.fs +++ b/src/myWebLog.Data/WebLog.fs @@ -1,21 +1,24 @@ module myWebLog.Data.WebLog +open FSharp.Interop.Dynamic open myWebLog.Entities open Rethink -open RethinkDb.Driver -open RethinkDb.Driver.Net +open System.Dynamic -let private r = RethinkDB.R +let private r = RethinkDb.Driver.RethinkDB.R -type PageList = { pageList : Ast.CoerceTo } +type PageList = { pageList : obj } /// Detemine the web log by the URL base -let tryFindWebLogByUrlBase (conn : IConnection) (urlBase : string) = - r.Table(Table.WebLog).GetAll([| urlBase |]).OptArg("index", "urlBase") - .Merge(fun webLog -> { pageList = r.Table(Table.Page) - .GetAll([| webLog.["id"], true |]).OptArg("index", "pageList") - .OrderBy("title") - .Pluck([| "title", "permalink" |]) - .CoerceTo("array") }) - |> runCursorAsync conn +let tryFindWebLogByUrlBase conn (urlBase : string) = + r.Table(Table.WebLog) + .GetAll(urlBase).OptArg("index", "urlBase") + .Merge(fun webLog -> { pageList = + r.Table(Table.Page) + .GetAll(webLog.["id"], true).OptArg("index", "pageList") + .OrderBy("title") + .Pluck("title", "permalink") + .CoerceTo("array") }) + .RunCursorAsync(conn) + |> await |> Seq.tryHead diff --git a/src/myWebLog.Web/PostModule.fs b/src/myWebLog.Web/PostModule.fs index dab34e4..023d744 100644 --- a/src/myWebLog.Web/PostModule.fs +++ b/src/myWebLog.Web/PostModule.fs @@ -64,7 +64,7 @@ type PostModule(conn : IConnection, clock : IClock) as this = /// Derive a post or page from the URL, or redirect from a prior URL to the current one member this.CatchAll (parameters : DynamicDictionary) = - let url : string = parameters.["permalink"].ToString () + let url = parameters.["permalink"].ToString () match tryFindPostByPermalink conn this.WebLog.id url with | Some post -> // Hopefully the most common result; the permalink is a permalink! let model = PostModel(this.Context, this.WebLog, post) @@ -88,7 +88,7 @@ type PostModule(conn : IConnection, clock : IClock) as this = /// Display categorized posts member this.CategorizedPosts (parameters : DynamicDictionary) = - let slug : string = downcast parameters.["slug"] + let slug = parameters.["slug"].ToString () match tryFindCategoryBySlug conn this.WebLog.id slug with | Some cat -> let pageNbr = getPage parameters let model = PostsModel(this.Context, this.WebLog) @@ -113,9 +113,9 @@ type PostModule(conn : IConnection, clock : IClock) as this = /// Display tagged posts member this.TaggedPosts (parameters : DynamicDictionary) = - let tag : string = downcast parameters.["tag"] - let pageNbr = getPage parameters - let model = PostsModel(this.Context, this.WebLog) + let tag = parameters.["tag"].ToString () + let pageNbr = getPage parameters + let model = PostsModel(this.Context, this.WebLog) model.pageNbr <- pageNbr model.posts <- findPageOfTaggedPosts conn this.WebLog.id tag pageNbr 10 model.hasNewer <- match List.isEmpty model.posts with diff --git a/src/myWebLog.Web/UserModule.fs b/src/myWebLog.Web/UserModule.fs index ba4a176..91a6c50 100644 --- a/src/myWebLog.Web/UserModule.fs +++ b/src/myWebLog.Web/UserModule.fs @@ -28,7 +28,9 @@ type UserModule(conn : IConnection) as this = /// Show the log on page member this.ShowLogOn (parameters : DynamicDictionary) = let model = LogOnModel(this.Context, this.WebLog) - model.returnUrl <- defaultArg (Option.ofObj(downcast parameters.["returnUrl"])) "" + model.returnUrl <- match parameters.ContainsKey "returnUrl" with + | true -> parameters.["returnUrl"].ToString () + | _ -> "" this.View.["admin/user/logon", model] /// Process a user log on diff --git a/src/myWebLog/views/themes/default/index-content.html b/src/myWebLog/views/themes/default/index-content.html index 7b1edb2..784a51d 100644 --- a/src/myWebLog/views/themes/default/index-content.html +++ b/src/myWebLog/views/themes/default/index-content.html @@ -12,8 +12,8 @@

-   @Current.publishedDate -   @Current.publishedTime +   @Current.publishedDate +   @Current.publishedTime

@Current.text