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

Indexes and subtitle

Browse Source 
Refactored index creation to a much more functional approach; fixed
issue where subtitle was displaying Some(subtitle)
This commit is contained in:
Daniel J. Summers 2016-07-18 23:03:44 -05:00
parent f66c3e3c58
commit f6c3abfcac
4 changed files with 51 additions and 111 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -6,28 +6,26 @@ open Rethink
open RethinkDb.Driver.Ast open RethinkDb.Driver.Ast
let private r = RethinkDB.R let private r = 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 let private result task = task |> Async.AwaitTask |> Async.RunSynchronously
/// Ensure the myWebLog database exists
let checkDatabase (cfg : DataConfig) = let checkDatabase (cfg : DataConfig) =
logStep "|> Checking database" logStep "|> Checking database"
let dbs = r.DbList() let dbs = r.DbList() |> runListAsync<string> cfg.conn
|> runListAsync<string> cfg.conn
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 r.DbCreate cfg.database |> runResultAsync cfg.conn |> ignore
|> runResultAsync cfg.conn
|> ignore
logStepDone () logStepDone ()
/// Ensure all required tables exist
let checkTables cfg = let checkTables cfg =
logStep "|> Checking tables" logStep "|> Checking tables"
let tables = r.Db(cfg.database).TableList() let tables = r.Db(cfg.database).TableList() |> runListAsync<string> cfg.conn
|> runListAsync<string> cfg.conn
[ 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
@ -35,117 +33,58 @@ 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 create |> runResultAsync cfg.conn |> ignore
|> runResultAsync cfg.conn
|> ignore
logStepDone ()) logStepDone ())
/// 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)
let createIndex cfg table index = /// Create the given index
logStepStart (sprintf """ Creating index "%s" on table %s""" index table) let createIndex cfg table (index : string * (ReqlExpr -> obj)) =
(tbl cfg table).IndexCreate(index) logStepStart (sprintf """ Creating index "%s" on table %s""" (fst index) table)
|> runResultAsync cfg.conn (tbl cfg table).IndexCreate (fst index, snd index) |> runResultAsync cfg.conn |> ignore
|> ignore (tbl cfg table).IndexWait (fst index) |> runAtomAsync cfg.conn |> ignore
(tbl cfg table).IndexWait(index)
|> runAtomAsync cfg.conn
|> ignore
logStepDone () logStepDone ()
let chkIndexes cfg table (indexes : string list) = /// Ensure that the given indexes exist, and create them if required
let idx = (tbl cfg table).IndexList() let ensureIndexes cfg (indexes : (string * (string * (ReqlExpr -> obj)) list) list) =
|> runListAsync<string> cfg.conn
indexes indexes
|> List.iter (fun index -> match idx.Contains index with |> List.iter (fun tabl -> let idx = (tbl cfg (fst tabl)).IndexList() |> runListAsync<string> cfg.conn
| true -> () snd tabl
| _ -> createIndex cfg table index) |> List.iter (fun index -> match idx.Contains (fst index) with
idx | true -> ()
| _ -> createIndex cfg (fst tabl) index))
let checkCategoryIndexes cfg = /// Create an index on a single field
chkIndexes cfg Table.Category [ "webLogId"; "slug" ] let singleField (name : string) : ReqlExpr -> obj = fun row -> upcast row.[name]
|> ignore
let checkCommentIndexes cfg = /// Create an index on web log Id and the given field
chkIndexes cfg Table.Comment [ "postId" ] let webLogField (name : string) : ReqlExpr -> obj = fun row -> upcast r.Array(row.["webLogId"], row.[name])
|> ignore
let checkPageIndexes cfg =
let idx = chkIndexes cfg Table.Page [ "webLogId" ]
match idx.Contains "permalink" with
| true -> ()
| _ -> logStepStart (sprintf """ Creating index "permalink" on table %s""" Table.Page)
(tbl cfg Table.Page)
.IndexCreate("permalink", ReqlFunction1(fun row -> upcast r.Array(row.["webLogId"], row.["permalink"])))
|> runResultAsync cfg.conn
|> ignore
(tbl cfg Table.Page).IndexWait "permalink"
|> runAtomAsync cfg.conn
|> ignore
logStepDone ()
match idx.Contains "pageList" with
| true -> ()
| _ -> logStepStart (sprintf """ Creating index "pageList" on table %s""" Table.Page)
(tbl cfg Table.Page)
.IndexCreate("pageList", ReqlFunction1(fun row -> upcast r.Array(row.["webLogId"], row.["showInPageList"])))
|> runResultAsync cfg.conn
|> ignore
(tbl cfg Table.Page).IndexWait "pageList"
|> runAtomAsync cfg.conn
|> ignore
logStepDone ()
let checkPostIndexes cfg =
let idx = chkIndexes cfg Table.Post [ "webLogId" ]
match idx.Contains "webLogAndStatus" with
| true -> ()
| _ -> logStepStart (sprintf """ Creating index "webLogAndStatus" on table %s""" Table.Post)
(tbl cfg Table.Post)
.IndexCreate("webLogAndStatus", ReqlFunction1(fun row -> upcast r.Array(row.["webLogId"], row.["status"])))
|> runResultAsync cfg.conn
|> ignore
(tbl cfg Table.Post).IndexWait "webLogAndStatus"
|> runAtomAsync cfg.conn
|> ignore
logStepDone ()
match idx.Contains "permalink" with
| true -> ()
| _ -> logStepStart (sprintf """ Creating index "permalink" on table %s""" Table.Post)
(tbl cfg Table.Post)
.IndexCreate("permalink", ReqlFunction1(fun row -> upcast r.Array(row.["webLogId"], row.["permalink"])))
|> runResultAsync cfg.conn
|> ignore
(tbl cfg Table.Post).IndexWait "permalink"
|> runAtomAsync cfg.conn
|> ignore
logStepDone ()
let checkUserIndexes cfg =
let idx = chkIndexes cfg Table.User [ ]
match idx.Contains "logOn" with
| true -> ()
| _ -> logStepStart (sprintf """ Creating index "logOn" on table %s""" Table.User)
(tbl cfg Table.User)
.IndexCreate("logOn", ReqlFunction1(fun row -> upcast r.Array(row.["userName"], row.["passwordHash"])))
|> runResultAsync cfg.conn
|> ignore
(tbl cfg Table.User).IndexWait "logOn"
|> runAtomAsync cfg.conn
|> ignore
logStepDone ()
let checkWebLogIndexes cfg =
chkIndexes cfg Table.WebLog [ "urlBase" ]
|> ignore
/// Ensure all the required indexes exist
let checkIndexes cfg = let checkIndexes cfg =
logStep "|> Checking indexes" logStep "|> Checking indexes"
checkCategoryIndexes cfg [ Table.Category, [ "webLogId", singleField "webLogId"
checkCommentIndexes cfg "slug", webLogField "slug"
checkPageIndexes cfg ]
checkPostIndexes cfg Table.Comment, [ "postId", singleField "postId"
checkUserIndexes cfg ]
checkWebLogIndexes cfg Table.Page, [ "webLogId", singleField "webLogId"
"permalink", webLogField "permalink"
"pageList", webLogField "showInPageList"
]
Table.Post, [ "webLogId", singleField "webLogId"
"webLogAndStatus", webLogField "status"
"permalink", webLogField "permalink"
]
Table.User, [ "logOn", fun row -> upcast r.Array(row.["userName"], row.["passwordHash"])
]
Table.WebLog, [ "urlBase", singleField "urlBase"
]
]
|> ensureIndexes cfg
/// Start up checks to ensure the database, tables, and indexes exist
let startUpCheck cfg = let startUpCheck cfg =
logStep "Database Start Up Checks Starting" logStep "Database Start Up Checks Starting"
checkDatabase cfg checkDatabase cfg

1
src/myWebLog.Web/App.fs
View File

@ -31,7 +31,6 @@ let cfg = try DataConfig.fromJson (System.IO.File.ReadAllText "data-config.json"
do do
startUpCheck cfg startUpCheck cfg
/// Support RESX lookup via the @Translate SSVE alias /// Support RESX lookup via the @Translate SSVE alias
type TranslateTokenViewEngineMatcher() = type TranslateTokenViewEngineMatcher() =
static let regex = Regex("@Translate\.(?<TranslationKey>[a-zA-Z0-9-_]+);?", RegexOptions.Compiled) static let regex = Regex("@Translate\.(?<TranslationKey>[a-zA-Z0-9-_]+);?", RegexOptions.Compiled)

2
src/myWebLog.Web/ViewModels.fs
View File

@ -47,6 +47,8 @@ type MyWebLogModel(ctx : NancyContext, webLog : WebLog) =
/// The web log for this request /// The web log for this request
member this.webLog = webLog member this.webLog = webLog
/// The subtitle for the webLog (SSVE can't do IsSome that deep)
member this.webLogSubtitle = defaultArg this.webLog.subtitle ""
/// User messages /// User messages
member val messages = getMessages () with get, set member val messages = getMessages () with get, set
/// The currently logged in user /// The currently logged in user

2
src/myWebLog/views/themes/default/layout.html
View File

@ -16,7 +16,7 @@
<div class="navbar-header"> <div class="navbar-header">
<a class="navbar-brand" href="/">@Model.webLog.name</a> <a class="navbar-brand" href="/">@Model.webLog.name</a>
</div> </div>
<p class="navbar-text">@Model.webLog.subtitle</p> <p class="navbar-text">@Model.webLogSubtitle</p>
<ul class="nav navbar-nav navbar-left"> <ul class="nav navbar-nav navbar-left">
@Each.webLog.pageList @Each.webLog.pageList
<li><a href="/@Current.permalink">@Current.title</a></li> <li><a href="/@Current.permalink">@Current.title</a></li>