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

Adios, pretty Rethink functions...

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

114
src/myWebLog.Data/Category.fs
View File

@ -5,11 +5,13 @@ open myWebLog.Entities
open Rethink open Rethink
open System.Dynamic open System.Dynamic
let private r = RethinkDb.Driver.RethinkDB.R
/// Shorthand to get a category by Id and filter by web log Id /// Shorthand to get a category by Id and filter by web log Id
let private category webLogId catId = let private category (webLogId : string) (catId : string) =
table Table.Category r.Table(Table.Category)
|> get catId .Get(catId)
|> filter (fun c -> upcast c.["webLogId"].Eq(webLogId)) .Filter(fun c -> c.["webLogId"].Eq(webLogId))
/// Sort categories by their name, with their children sorted below them, including an indent level /// Sort categories by their name, with their children sorted below them, including an indent level
let sortCategories categories = let sortCategories categories =
@ -26,28 +28,26 @@ let sortCategories categories =
|> Seq.toList |> Seq.toList
/// Get all categories for a web log /// Get all categories for a web log
let getAllCategories conn webLogId = let getAllCategories conn (webLogId : string) =
table Table.Category r.Table(Table.Category)
|> getAll [| webLogId |] .GetAll(webLogId).OptArg("index", "webLogId")
|> optArg "index" "webLogId" .OrderBy("name")
|> orderBy (fun c -> upcast c.["name"]) .RunCursorAsync<Category>(conn)
|> runCursorAsync<Category> conn |> await
|> Seq.toList |> Seq.toList
|> sortCategories |> sortCategories
/// Count categories for a web log /// Count categories for a web log
let countCategories conn webLogId = let countCategories conn (webLogId : string) =
table Table.Category r.Table(Table.Category)
|> getAll [| webLogId |] .GetAll(webLogId).OptArg("index", "webLogId")
|> optArg "index" "webLogId" .Count()
|> count .RunAtomAsync<int>(conn) |> await
|> runAtomAsync<int> conn
/// 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 =
match category webLogId catId match (category webLogId catId)
|> runAtomAsync<Category> conn .RunAtomAsync<Category>(conn) |> await |> box with
|> box with
| null -> None | null -> None
| cat -> Some <| unbox cat | cat -> Some <| unbox cat
@ -56,20 +56,18 @@ let saveCategory conn webLogId (cat : Category) =
match cat.id with match cat.id with
| "new" -> let newCat = { cat with id = string <| System.Guid.NewGuid() | "new" -> let newCat = { cat with id = string <| System.Guid.NewGuid()
webLogId = webLogId } webLogId = webLogId }
table Table.Category r.Table(Table.Category)
|> insert newCat .Insert(newCat)
|> runResultAsync conn .RunResultAsync(conn) |> await |> ignore
|> ignore
newCat.id newCat.id
| _ -> let upd8 = ExpandoObject() | _ -> let upd8 = ExpandoObject()
upd8?name <- cat.name upd8?name <- cat.name
upd8?slug <- cat.slug upd8?slug <- cat.slug
upd8?description <- cat.description upd8?description <- cat.description
upd8?parentId <- cat.parentId upd8?parentId <- cat.parentId
category webLogId cat.id (category webLogId cat.id)
|> update upd8 .Update(upd8)
|> runResultAsync conn .RunResultAsync(conn) |> await |> ignore
|> ignore
cat.id cat.id
/// Remove a category from a given parent /// Remove a category from a given parent
@ -77,11 +75,10 @@ let removeCategoryFromParent conn webLogId parentId catId =
match tryFindCategory conn webLogId parentId with match tryFindCategory conn webLogId parentId with
| Some parent -> let upd8 = ExpandoObject() | Some parent -> let upd8 = ExpandoObject()
upd8?children <- parent.children upd8?children <- parent.children
|> List.filter (fun ch -> ch <> catId) |> List.filter (fun childId -> childId <> catId)
category webLogId parentId (category webLogId parentId)
|> update upd8 .Update(upd8)
|> runResultAsync conn .RunResultAsync(conn) |> await |> ignore
|> ignore
| None -> () | None -> ()
/// Add a category to a given parent /// Add a category to a given parent
@ -89,10 +86,9 @@ let addCategoryToParent conn webLogId parentId catId =
match tryFindCategory conn webLogId parentId with match tryFindCategory conn webLogId parentId with
| Some parent -> let upd8 = ExpandoObject() | Some parent -> let upd8 = ExpandoObject()
upd8?children <- catId :: parent.children upd8?children <- catId :: parent.children
category webLogId parentId (category webLogId parentId)
|> update upd8 .Update(upd8)
|> runResultAsync conn .RunResultAsync(conn) |> await |> ignore
|> ignore
| None -> () | None -> ()
/// Delete a category /// Delete a category
@ -105,37 +101,33 @@ let deleteCategory conn cat =
let newParent = ExpandoObject() let newParent = ExpandoObject()
newParent?parentId <- cat.parentId newParent?parentId <- cat.parentId
cat.children cat.children
|> List.iter (fun childId -> category cat.webLogId childId |> List.iter (fun childId -> (category cat.webLogId childId)
|> update newParent .Update(newParent)
|> runResultAsync conn .RunResultAsync(conn) |> await |> ignore)
|> ignore)
// Remove the category from posts where it is assigned // Remove the category from posts where it is assigned
table Table.Post r.Table(Table.Post)
|> getAll [| cat.webLogId |] .GetAll(cat.webLogId).OptArg("index", "webLogId")
|> optArg "index" "webLogId" .Filter(fun p -> p.["categoryIds"].Contains(cat.id))
|> filter (fun p -> upcast p.["categoryIds"].Contains(cat.id)) .RunCursorAsync<Post>(conn)
|> runCursorAsync<Post> conn |> await
|> Seq.toList |> Seq.toList
|> List.iter (fun post -> let newCats = ExpandoObject() |> List.iter (fun post -> let newCats = ExpandoObject()
newCats?categoryIds <- post.categoryIds newCats?categoryIds <- post.categoryIds
|> List.filter (fun c -> c <> cat.id) |> List.filter (fun c -> c <> cat.id)
table Table.Post r.Table(Table.Post)
|> get post.id .Get(post.id)
|> update newCats .Update(newCats)
|> runResultAsync conn .RunResultAsync(conn) |> await |> ignore)
|> ignore)
// Now, delete the category // Now, delete the category
table Table.Category r.Table(Table.Category)
|> get cat.id .Get(cat.id)
|> delete .Delete()
|> runResultAsync conn .RunResultAsync(conn) |> await |> ignore
|> ignore
/// Get a category by its slug /// Get a category by its slug
let tryFindCategoryBySlug conn webLogId slug = let tryFindCategoryBySlug conn (webLogId : string) (slug : string) =
table Table.Category r.Table(Table.Category)
|> getAll [| slug |] .GetAll(webLogId, slug).OptArg("index", "slug")
|> optArg "index" "slug" .RunCursorAsync<Category>(conn)
|> filter (fun c -> upcast c.["webLogId"].Eq(webLogId)) |> await
|> runCursorAsync<Category> conn
|> Seq.tryHead |> Seq.tryHead

79
src/myWebLog.Data/Page.fs
View File

@ -5,63 +5,62 @@ open myWebLog.Entities
open Rethink open Rethink
open System.Dynamic open System.Dynamic
let private r = RethinkDb.Driver.RethinkDB.R
/// Shorthand to get the page by its Id, filtering on web log Id /// Shorthand to get the page by its Id, filtering on web log Id
let private page webLogId pageId = let private page (webLogId : string) (pageId : string) =
table Table.Page r.Table(Table.Page)
|> get pageId .Get(pageId)
|> filter (fun p -> upcast p.["webLogId"].Eq(webLogId)) .Filter(fun p -> p.["webLogId"].Eq(webLogId))
/// Get a page by its Id /// Get a page by its Id
let tryFindPage conn webLogId pageId : Page option = let tryFindPage conn webLogId pageId : Page option =
match page webLogId pageId match (page webLogId pageId)
|> runAtomAsync<Page> conn .RunAtomAsync<Page>(conn) |> await |> box with
|> box with
| null -> None | null -> None
| page -> Some <| unbox page | page -> Some <| unbox page
/// Get a page by its Id (excluding revisions) /// Get a page by its Id (excluding revisions)
let tryFindPageWithoutRevisions conn webLogId pageId : Page option = let tryFindPageWithoutRevisions conn webLogId pageId : Page option =
match page webLogId pageId match (page webLogId pageId)
|> without [| "revisions" |] .Without("revisions")
|> runAtomAsync<Page> conn .RunAtomAsync<Page>(conn) |> await |> box with
|> box with
| null -> None | null -> None
| page -> Some <| unbox page | page -> Some <| unbox page
/// Find a page by its permalink /// Find a page by its permalink
let tryFindPageByPermalink conn webLogId permalink = let tryFindPageByPermalink conn (webLogId : string) (permalink : string) =
table Table.Page r.Table(Table.Page)
|> getAll [| webLogId; permalink |] .GetAll(webLogId, permalink).OptArg("index", "permalink")
|> optArg "index" "permalink" .Without("revisions")
|> without [| "revisions" |] .RunCursorAsync<Page>(conn)
|> runCursorAsync<Page> conn |> await
|> Seq.tryHead |> Seq.tryHead
/// Count pages for a web log /// Count pages for a web log
let countPages conn webLogId = let countPages conn (webLogId : string) =
table Table.Page r.Table(Table.Page)
|> getAll [| webLogId |] .GetAll(webLogId).OptArg("index", "webLogId")
|> optArg "index" "webLogId" .Count()
|> count .RunAtomAsync<int>(conn) |> await
|> runAtomAsync<int> conn
/// Get a list of all pages (excludes page text and revisions) /// Get a list of all pages (excludes page text and revisions)
let findAllPages conn webLogId = let findAllPages conn (webLogId : string) =
table Table.Page r.Table(Table.Page)
|> getAll [| webLogId |] .GetAll(webLogId)
|> orderBy (fun p -> upcast p.["title"]) .OrderBy("title")
|> without [| "text"; "revisions" |] .Without("text", "revisions")
|> runCursorAsync<Page> conn .RunCursorAsync<Page>(conn)
|> await
|> Seq.toList |> Seq.toList
/// Save a page /// Save a page
let savePage conn (pg : Page) = let savePage conn (pg : Page) =
match pg.id with match pg.id with
| "new" -> let newPage = { pg with id = string <| System.Guid.NewGuid() } | "new" -> let newPage = { pg with id = string <| System.Guid.NewGuid() }
table Table.Page r.Table(Table.Page)
|> insert page .Insert(page)
|> runResultAsync conn .RunResultAsync(conn) |> await |> ignore
|> ignore
newPage.id newPage.id
| _ -> let upd8 = ExpandoObject() | _ -> let upd8 = ExpandoObject()
upd8?title <- pg.title upd8?title <- pg.title
@ -70,15 +69,13 @@ let savePage conn (pg : Page) =
upd8?updatedOn <- pg.updatedOn upd8?updatedOn <- pg.updatedOn
upd8?text <- pg.text upd8?text <- pg.text
upd8?revisions <- pg.revisions upd8?revisions <- pg.revisions
page pg.webLogId pg.id (page pg.webLogId pg.id)
|> update upd8 .Update(upd8)
|> runResultAsync conn .RunResultAsync(conn) |> await |> ignore
|> ignore
pg.id pg.id
/// Delete a page /// Delete a page
let deletePage conn webLogId pageId = let deletePage conn webLogId pageId =
page webLogId pageId (page webLogId pageId)
|> delete .Delete()
|> runResultAsync conn .RunResultAsync(conn) |> await |> ignore
|> ignore

157
src/myWebLog.Data/Post.fs
View File

@ -3,36 +3,43 @@
open FSharp.Interop.Dynamic open FSharp.Interop.Dynamic
open myWebLog.Entities open myWebLog.Entities
open Rethink open Rethink
open RethinkDb.Driver
open RethinkDb.Driver.Ast open RethinkDb.Driver.Ast
open System.Dynamic 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 /// Shorthand to select all published posts for a web log
let private publishedPosts webLogId = let private publishedPosts (webLogId : string)=
table Table.Post r.Table(Table.Post)
|> getAll [| webLogId; PostStatus.Published |] .GetAll(r.Array(webLogId, PostStatus.Published)).OptArg("index", "webLogAndStatus")
|> optArg "index" "webLogAndStatus"
/// Shorthand to sort posts by published date, slice for the given page, and return a list /// 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 filter
|> orderBy (fun p -> upcast r.Desc(p.["publishedOn"])) .OrderBy(r.Desc("publishedOn"))
|> slice ((pageNbr - 1) * nbrPerPage) (pageNbr * nbrPerPage) .Slice((pageNbr - 1) * nbrPerPage, pageNbr * nbrPerPage)
|> runAtomAsync<System.Collections.Generic.List<Post>> conn .RunListAsync<Post>(conn)
|> await
|> Seq.toList |> Seq.toList
/// Shorthand to get a newer or older post /// Shorthand to get a newer or older post
let private adjacentPost conn post theFilter = // TODO: older posts need to sort by published on DESC
System.Console.WriteLine "Adjacent post" //let private adjacentPost conn post (theFilter : ReqlExpr -> ReqlExpr) (sort :ReqlExpr) : Post option =
publishedPosts post.webLogId let private adjacentPost conn post (theFilter : obj) (sort : obj) : Post option =
|> filter theFilter (publishedPosts post.webLogId)
|> orderBy (fun p -> upcast p.["publishedOn"]) .Filter(theFilter)
|> limit 1 .OrderBy(sort)
|> runCursorAsync<Post> conn .Limit(1)
.RunListAsync<Post>(conn)
|> await
|> Seq.tryHead |> 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 /// Get a page of published posts
let findPageOfPublishedPosts conn webLogId pageNbr nbrPerPage = let findPageOfPublishedPosts conn webLogId pageNbr nbrPerPage =
publishedPosts webLogId publishedPosts webLogId
@ -40,109 +47,109 @@ let findPageOfPublishedPosts conn webLogId pageNbr nbrPerPage =
/// Get a page of published posts assigned to a given category /// Get a page of published posts assigned to a given category
let findPageOfCategorizedPosts conn webLogId (categoryId : string) pageNbr nbrPerPage = let findPageOfCategorizedPosts conn webLogId (categoryId : string) pageNbr nbrPerPage =
publishedPosts webLogId (publishedPosts webLogId)
|> filter (fun p -> upcast p.["categoryIds"].Contains(categoryId)) .Filter(fun p -> p.["categoryIds"].Contains(categoryId))
|> toPostList conn pageNbr nbrPerPage |> toPostList conn pageNbr nbrPerPage
/// Get a page of published posts tagged with a given tag /// Get a page of published posts tagged with a given tag
let findPageOfTaggedPosts conn webLogId (tag : string) pageNbr nbrPerPage = let findPageOfTaggedPosts conn webLogId (tag : string) pageNbr nbrPerPage =
publishedPosts webLogId (publishedPosts webLogId)
|> filter (fun p -> upcast p.["tags"].Contains(tag)) .Filter(fun p -> p.["tags"].Contains(tag))
|> toPostList conn pageNbr nbrPerPage |> toPostList conn pageNbr nbrPerPage
/// Try to get the next newest post from the given post /// 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 /// Try to get the next newest post assigned to the given category
let tryFindNewerCategorizedPost conn (categoryId : string) post = let tryFindNewerCategorizedPost conn (categoryId : string) post =
adjacentPost conn post newerPost conn post (fun p -> (p :> ReqlExpr).["publishedOn"].Gt(post.publishedOn)
(fun p -> upcast p.["publishedOn"].Gt(post.publishedOn).And(p.["categoryIds"].Contains(categoryId))) .And(p.["categoryIds"].Contains(categoryId)))
/// Try to get the next newest tagged post from the given tagged post /// Try to get the next newest tagged post from the given tagged post
let tryFindNewerTaggedPost conn (tag : string) 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 /// 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 /// Try to get the next oldest post assigned to the given category
let tryFindOlderCategorizedPost conn (categoryId : string) post = let tryFindOlderCategorizedPost conn (categoryId : string) post =
adjacentPost conn post olderPost conn post (fun p -> (p :> ReqlExpr).["publishedOn"].Lt(post.publishedOn)
(fun p -> upcast p.["publishedOn"].Lt(post.publishedOn).And(p.["categoryIds"].Contains(categoryId))) .And(p.["categoryIds"].Contains(categoryId)))
/// Try to get the next oldest tagged post from the given tagged post /// Try to get the next oldest tagged post from the given tagged post
let tryFindOlderTaggedPost conn (tag : string) 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 /// Get a page of all posts in all statuses
let findPageOfAllPosts conn webLogId pageNbr nbrPerPage = let findPageOfAllPosts conn (webLogId : string) pageNbr nbrPerPage =
table Table.Post r.Table(Table.Post)
|> getAll [| webLogId |] .GetAll(webLogId).OptArg("index", "webLogId")
|> optArg "index" "webLogId" .OrderBy(fun p -> r.Desc(r.Branch(p.["publishedOn"].Eq(int64 0), p.["lastUpdatedOn"], p.["publishedOn"])))
|> orderBy (fun p -> upcast r.Desc(r.Branch(p.["publishedOn"].Eq(int64 0), p.["lastUpdatedOn"], p.["publishedOn"]))) .Slice((pageNbr - 1) * nbrPerPage, pageNbr * nbrPerPage)
|> slice ((pageNbr - 1) * nbrPerPage) (pageNbr * nbrPerPage) .RunCursorAsync<Post>(conn)
|> runCursorAsync<Post> conn |> await
|> Seq.toList |> Seq.toList
/// Try to find a post by its Id and web log Id /// Try to find a post by its Id and web log Id
let tryFindPost conn webLogId postId : Post option = let tryFindPost conn webLogId postId : Post option =
match table Table.Post match r.Table(Table.Post)
|> get postId .Get(postId)
|> filter (fun p -> upcast p.["webLogId"].Eq(webLogId)) .Filter(fun p -> p.["webLogId"].Eq(webLogId))
|> runAtomAsync<Post> conn .RunAtomAsync<Post>(conn)
|> box with |> box with
| null -> None | null -> None
| post -> Some <| unbox post | post -> Some <| unbox post
/// Try to find a post by its permalink /// Try to find a post by its permalink
let tryFindPostByPermalink conn webLogId permalink = let tryFindPostByPermalink conn webLogId permalink =
(table Table.Post r.Table(Table.Post)
|> getAll [| webLogId; permalink |] .GetAll(r.Array(webLogId, permalink)).OptArg("index", "permalink")
|> optArg "index" "permalink" .Filter(fun p -> p.["status"].Eq(PostStatus.Published))
|> filter (fun p -> upcast p.["status"].Eq(PostStatus.Published)) .Without("revisions")
|> without [| "revisions" |]) .Merge(fun post -> ExpandoObject()?categories <-
.Merge(fun post -> ExpandoObject()?categories <- post.["categoryIds"]
post.["categoryIds"] .Map(ReqlFunction1(fun cat -> upcast r.Table(Table.Category).Get(cat).Without("children")))
.Map(ReqlFunction1(fun cat -> upcast r.Table(Table.Category).Get(cat).Without("children"))) .CoerceTo("array"))
.CoerceTo("array")) .Merge(fun post -> ExpandoObject()?comments <-
.Merge(fun post -> ExpandoObject()?comments <- r.Table(Table.Comment)
r.Table(Table.Comment) .GetAll(post.["id"]).OptArg("index", "postId")
.GetAll(post.["id"]).OptArg("index", "postId") .OrderBy("postedOn")
.OrderBy("postedOn") .CoerceTo("array"))
.CoerceTo("array")) .RunCursorAsync<Post>(conn)
|> runCursorAsync<Post> conn |> await
|> Seq.tryHead |> Seq.tryHead
/// Try to find a post by its prior permalink /// Try to find a post by its prior permalink
let tryFindPostByPriorPermalink conn webLogId (permalink : string) = let tryFindPostByPriorPermalink conn (webLogId : string) (permalink : string) =
table Table.Post r.Table(Table.Post)
|> getAll [| webLogId |] .GetAll(webLogId).OptArg("index", "webLogId")
|> optArg "index" "webLogId" .Filter(fun p -> p.["priorPermalinks"].Contains(permalink).And(p.["status"].Eq(PostStatus.Published)))
|> filter (fun p -> upcast p.["priorPermalinks"].Contains(permalink).And(p.["status"].Eq(PostStatus.Published))) .Without("revisions")
|> without [| "revisions" |] .RunCursorAsync<Post>(conn)
|> runCursorAsync<Post> conn |> await
|> Seq.tryHead |> Seq.tryHead
/// Save a post /// Save a post
let savePost conn post = let savePost conn post =
match post.id with match post.id with
| "new" -> let newPost = { post with id = string <| System.Guid.NewGuid() } | "new" -> let newPost = { post with id = string <| System.Guid.NewGuid() }
table Table.Post r.Table(Table.Post)
|> insert newPost .Insert(newPost)
|> runResultAsync conn .RunResultAsync(conn)
|> ignore |> ignore
newPost.id newPost.id
| _ -> table Table.Post | _ -> r.Table(Table.Post)
|> get post.id .Get(post.id)
|> replace post .Replace(post)
|> runResultAsync conn .RunResultAsync(conn)
|> ignore |> ignore
post.id post.id
/// Count posts for a web log /// Count posts for a web log
let countPosts conn webLogId = let countPosts conn (webLogId : string) =
table Table.Post r.Table(Table.Post)
|> getAll [| webLogId |] .GetAll(webLogId).OptArg("index", "webLogId")
|> optArg "index" "webLogId" .Count()
|> count .RunAtomAsync<int>(conn)
|> runAtomAsync<int> conn |> await

25
src/myWebLog.Data/Rethink.fs
View File

@ -3,25 +3,8 @@
open RethinkDb.Driver.Ast open RethinkDb.Driver.Ast
open RethinkDb.Driver.Net open RethinkDb.Driver.Net
let private r = RethinkDb.Driver.RethinkDB.R let await task = task |> Async.AwaitTask |> Async.RunSynchronously
let private await task = task |> Async.AwaitTask |> Async.RunSynchronously
let count (expr : ReqlExpr) = expr.Count () type ReqlExpr with
let delete (expr : ReqlExpr) = expr.Delete () /// Run a SUCCESS_ATOM response that returns multiple values
let filter (expr : ReqlExpr -> ReqlExpr) (table : ReqlExpr) = table.Filter expr member this.RunListAsync<'T> (conn : IConnection) = this.RunAtomAsync<System.Collections.Generic.List<'T>> conn
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

31
src/myWebLog.Data/SetUp.fs
View File

@ -1,31 +1,28 @@
module myWebLog.Data.SetUp module myWebLog.Data.SetUp
open RethinkDb.Driver
open System
open Rethink open Rethink
open RethinkDb.Driver.Ast 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 logStep step = Console.Out.WriteLine (sprintf "[myWebLog] %s" step)
let private logStepStart text = Console.Out.Write (sprintf "[myWebLog] %s..." text) let private logStepStart text = Console.Out.Write (sprintf "[myWebLog] %s..." text)
let private logStepDone () = Console.Out.WriteLine (" done.") let private logStepDone () = Console.Out.WriteLine (" done.")
let private result task = task |> Async.AwaitTask |> Async.RunSynchronously
/// Ensure the myWebLog database exists /// Ensure the myWebLog database exists
let checkDatabase (cfg : DataConfig) = let checkDatabase (cfg : DataConfig) =
logStep "|> Checking database" 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 match dbs.Contains cfg.database with
| true -> () | true -> ()
| _ -> logStepStart (sprintf " %s database not found - creating" cfg.database) | _ -> 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 () logStepDone ()
/// Ensure all required tables exist /// Ensure all required tables exist
let checkTables cfg = let checkTables cfg =
logStep "|> Checking tables" 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 ] [ Table.Category; Table.Comment; Table.Page; Table.Post; Table.User; Table.WebLog ]
|> List.map (fun tbl -> match tables.Contains tbl with |> List.map (fun tbl -> match tables.Contains tbl with
| true -> None | true -> None
@ -33,33 +30,33 @@ let checkTables cfg =
|> List.filter (fun create -> create.IsSome) |> List.filter (fun create -> create.IsSome)
|> List.map (fun create -> create.Value) |> List.map (fun create -> create.Value)
|> List.iter (fun (tbl, create) -> logStepStart (sprintf " Creating table %s" tbl) |> List.iter (fun (tbl, create) -> logStepStart (sprintf " Creating table %s" tbl)
create |> runResultAsync cfg.conn |> ignore create.RunResultAsync(cfg.conn) |> await |> ignore
logStepDone ()) logStepDone ())
/// Shorthand to get the table /// Shorthand to get the table
let tbl cfg table = r.Db(cfg.database).Table(table) let tbl cfg table = r.Db(cfg.database).Table(table)
/// Create the given index /// 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) 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).IndexCreate(fst index, snd index).RunResultAsync(cfg.conn) |> await |> ignore
(tbl cfg table).IndexWait (fst index) |> runAtomAsync cfg.conn |> ignore (tbl cfg table).IndexWait(fst index).RunAtomAsync(cfg.conn) |> await |> ignore
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 ensureIndexes cfg (indexes : (string * (string * (ReqlExpr -> obj)) list) list) = let ensureIndexes cfg (indexes : (string * (string * obj) list) list) =
indexes 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 snd tabl
|> List.iter (fun index -> match idx.Contains (fst index) with |> List.iter (fun index -> match idx.Contains (fst index) with
| true -> () | true -> ()
| _ -> createIndex cfg (fst tabl) index)) | _ -> createIndex cfg (fst tabl) index))
/// Create an index on a single field /// 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 /// 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 /// Ensure all the required indexes exist
let checkIndexes cfg = let checkIndexes cfg =
@ -77,7 +74,7 @@ let checkIndexes cfg =
"webLogAndStatus", webLogField "status" "webLogAndStatus", webLogField "status"
"permalink", webLogField "permalink" "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" Table.WebLog, [ "urlBase", singleField "urlBase"
] ]

13
src/myWebLog.Data/User.fs
View File

@ -3,10 +3,13 @@
open myWebLog.Entities open myWebLog.Entities
open Rethink open Rethink
let private r = RethinkDb.Driver.RethinkDB.R
/// Log on a user /// Log on a user
let tryUserLogOn conn email passwordHash = // FIXME: the password hash may be longer than the significant size of a RethinkDB index
table Table.User let tryUserLogOn conn (email : string) (passwordHash : string) =
|> getAll [| email, passwordHash |] r.Table(Table.User)
|> optArg "index" "logOn" .GetAll(email, passwordHash).OptArg("index", "logOn")
|> runCursorAsync<User> conn .RunCursorAsync<User>(conn)
|> await
|> Seq.tryHead |> Seq.tryHead

27
src/myWebLog.Data/WebLog.fs
View File

@ -1,21 +1,24 @@
module myWebLog.Data.WebLog module myWebLog.Data.WebLog
open FSharp.Interop.Dynamic
open myWebLog.Entities open myWebLog.Entities
open Rethink open Rethink
open RethinkDb.Driver open System.Dynamic
open RethinkDb.Driver.Net
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 /// Detemine the web log by the URL base
let tryFindWebLogByUrlBase (conn : IConnection) (urlBase : string) = let tryFindWebLogByUrlBase conn (urlBase : string) =
r.Table(Table.WebLog).GetAll([| urlBase |]).OptArg("index", "urlBase") r.Table(Table.WebLog)
.Merge(fun webLog -> { pageList = r.Table(Table.Page) .GetAll(urlBase).OptArg("index", "urlBase")
.GetAll([| webLog.["id"], true |]).OptArg("index", "pageList") .Merge(fun webLog -> { pageList =
.OrderBy("title") r.Table(Table.Page)
.Pluck([| "title", "permalink" |]) .GetAll(webLog.["id"], true).OptArg("index", "pageList")
.CoerceTo("array") }) .OrderBy("title")
|> runCursorAsync<WebLog> conn .Pluck("title", "permalink")
.CoerceTo("array") })
.RunCursorAsync<WebLog>(conn)
|> await
|> Seq.tryHead |> Seq.tryHead

10
src/myWebLog.Web/PostModule.fs
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 /// Derive a post or page from the URL, or redirect from a prior URL to the current one
member this.CatchAll (parameters : DynamicDictionary) = member this.CatchAll (parameters : DynamicDictionary) =
let url : string = parameters.["permalink"].ToString () let url = parameters.["permalink"].ToString ()
match tryFindPostByPermalink conn this.WebLog.id url with match tryFindPostByPermalink conn this.WebLog.id url with
| Some post -> // Hopefully the most common result; the permalink is a permalink! | Some post -> // Hopefully the most common result; the permalink is a permalink!
let model = PostModel(this.Context, this.WebLog, post) let model = PostModel(this.Context, this.WebLog, post)
@ -88,7 +88,7 @@ type PostModule(conn : IConnection, clock : IClock) as this =
/// Display categorized posts /// Display categorized posts
member this.CategorizedPosts (parameters : DynamicDictionary) = member this.CategorizedPosts (parameters : DynamicDictionary) =
let slug : string = downcast parameters.["slug"] let slug = parameters.["slug"].ToString ()
match tryFindCategoryBySlug conn this.WebLog.id slug with match tryFindCategoryBySlug conn this.WebLog.id slug with
| Some cat -> let pageNbr = getPage parameters | Some cat -> let pageNbr = getPage parameters
let model = PostsModel(this.Context, this.WebLog) let model = PostsModel(this.Context, this.WebLog)
@ -113,9 +113,9 @@ type PostModule(conn : IConnection, clock : IClock) as this =
/// Display tagged posts /// Display tagged posts
member this.TaggedPosts (parameters : DynamicDictionary) = member this.TaggedPosts (parameters : DynamicDictionary) =
let tag : string = downcast parameters.["tag"] let tag = parameters.["tag"].ToString ()
let pageNbr = getPage parameters let pageNbr = getPage parameters
let model = PostsModel(this.Context, this.WebLog) let model = PostsModel(this.Context, this.WebLog)
model.pageNbr <- pageNbr model.pageNbr <- pageNbr
model.posts <- findPageOfTaggedPosts conn this.WebLog.id tag pageNbr 10 model.posts <- findPageOfTaggedPosts conn this.WebLog.id tag pageNbr 10
model.hasNewer <- match List.isEmpty model.posts with model.hasNewer <- match List.isEmpty model.posts with

4
src/myWebLog.Web/UserModule.fs
View File

@ -28,7 +28,9 @@ type UserModule(conn : IConnection) as this =
/// Show the log on page /// Show the log on page
member this.ShowLogOn (parameters : DynamicDictionary) = member this.ShowLogOn (parameters : DynamicDictionary) =
let model = LogOnModel(this.Context, this.WebLog) 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] this.View.["admin/user/logon", model]
/// Process a user log on /// Process a user log on

4
src/myWebLog/views/themes/default/index-content.html
View File

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