Adios, pretty Rethink functions...

The wrapper functions around RethinkDB calls were causing more problems
than they were helping to eliminate; the data code doesn't look very
F#-y, but it works much better now.
This commit is contained in:
Daniel J. Summers 2016-07-19 22:44:39 -05:00
parent f6c3abfcac
commit 1a83727bc7
10 changed files with 224 additions and 240 deletions

View File

@ -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<Category> conn
let getAllCategories conn (webLogId : string) =
r.Table(Table.Category)
.GetAll(webLogId).OptArg("index", "webLogId")
.OrderBy("name")
.RunCursorAsync<Category>(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<int> conn
let countCategories conn (webLogId : string) =
r.Table(Table.Category)
.GetAll(webLogId).OptArg("index", "webLogId")
.Count()
.RunAtomAsync<int>(conn) |> await
/// Get a specific category by its Id
let tryFindCategory conn webLogId catId : Category option =
match category webLogId catId
|> runAtomAsync<Category> conn
|> box with
match (category webLogId catId)
.RunAtomAsync<Category>(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<Post> conn
r.Table(Table.Post)
.GetAll(cat.webLogId).OptArg("index", "webLogId")
.Filter(fun p -> p.["categoryIds"].Contains(cat.id))
.RunCursorAsync<Post>(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<Category> conn
let tryFindCategoryBySlug conn (webLogId : string) (slug : string) =
r.Table(Table.Category)
.GetAll(webLogId, slug).OptArg("index", "slug")
.RunCursorAsync<Category>(conn)
|> await
|> Seq.tryHead

View File

@ -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<Page> conn
|> box with
match (page webLogId pageId)
.RunAtomAsync<Page>(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<Page> conn
|> box with
match (page webLogId pageId)
.Without("revisions")
.RunAtomAsync<Page>(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<Page> conn
let tryFindPageByPermalink conn (webLogId : string) (permalink : string) =
r.Table(Table.Page)
.GetAll(webLogId, permalink).OptArg("index", "permalink")
.Without("revisions")
.RunCursorAsync<Page>(conn)
|> await
|> Seq.tryHead
/// Count pages for a web log
let countPages conn webLogId =
table Table.Page
|> getAll [| webLogId |]
|> optArg "index" "webLogId"
|> count
|> runAtomAsync<int> conn
let countPages conn (webLogId : string) =
r.Table(Table.Page)
.GetAll(webLogId).OptArg("index", "webLogId")
.Count()
.RunAtomAsync<int>(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<Page> conn
let findAllPages conn (webLogId : string) =
r.Table(Table.Page)
.GetAll(webLogId)
.OrderBy("title")
.Without("text", "revisions")
.RunCursorAsync<Page>(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

View File

@ -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<System.Collections.Generic.List<Post>> conn
.OrderBy(r.Desc("publishedOn"))
.Slice((pageNbr - 1) * nbrPerPage, pageNbr * nbrPerPage)
.RunListAsync<Post>(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<Post> 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<Post>(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<Post> 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<Post>(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<Post> conn
match r.Table(Table.Post)
.Get(postId)
.Filter(fun p -> p.["webLogId"].Eq(webLogId))
.RunAtomAsync<Post>(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<Post> 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<Post>(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<Post> 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<Post>(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<int> conn
let countPosts conn (webLogId : string) =
r.Table(Table.Post)
.GetAll(webLogId).OptArg("index", "webLogId")
.Count()
.RunAtomAsync<int>(conn)
|> await

View File

@ -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<System.Collections.Generic.List<'T>> 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
type ReqlExpr with
/// Run a SUCCESS_ATOM response that returns multiple values
member this.RunListAsync<'T> (conn : IConnection) = this.RunAtomAsync<System.Collections.Generic.List<'T>> conn

View File

@ -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<string> cfg.conn
let dbs = r.DbList().RunListAsync<string>(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<string> cfg.conn
let tables = r.Db(cfg.database).TableList().RunListAsync<string>(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<string> cfg.conn
|> List.iter (fun tabl -> let idx = (tbl cfg (fst tabl)).IndexList().RunListAsync<string>(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"
]

View File

@ -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<User> 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<User>(conn)
|> await
|> Seq.tryHead

View File

@ -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<WebLog> 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<WebLog>(conn)
|> await
|> Seq.tryHead

View File

@ -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

View File

@ -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

View File

@ -12,8 +12,8 @@
</h1>
<!-- var pubDate = moment(post.publishedDate) -->
<p>
<i class="fa fa-calendar" title="@Translate.Date" /> &nbsp; @Current.publishedDate <!-- #{pubDate.format('MMMM Do, YYYY')} -->
<i class="fa fa-clock-o" title="@Translate.Time" /> &nbsp; @Current.publishedTime <!-- #{pubDate.format('h:mma')} -->
<i class="fa fa-calendar" title="@Translate.Date"></i> &nbsp; @Current.publishedDate <!-- #{pubDate.format('MMMM Do, YYYY')} -->
<i class="fa fa-clock-o" title="@Translate.Time"></i> &nbsp; @Current.publishedTime <!-- #{pubDate.format('h:mma')} -->
</p>
@Current.text
</article>