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
let private r = 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 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
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 |> 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
[ Table.Category; Table.Comment; Table.Page; Table.Post; Table.User; Table.WebLog ]
|> List.map (fun tbl -> match tables.Contains tbl with
| true -> None
@ -35,117 +33,58 @@ 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 |> ignore
logStepDone ())
/// Shorthand to get the table
let tbl cfg table = r.Db(cfg.database).Table(table)
let createIndex cfg table index =
logStepStart (sprintf """ Creating index "%s" on table %s""" index table)
(tbl cfg table).IndexCreate(index)
|> runResultAsync cfg.conn
|> ignore
(tbl cfg table).IndexWait(index)
|> runAtomAsync cfg.conn
|> ignore
/// Create the given index
let createIndex cfg table (index : string * (ReqlExpr -> 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
logStepDone ()
let chkIndexes cfg table (indexes : string list) =
let idx = (tbl cfg table).IndexList()
|> runListAsync<string> cfg.conn
/// Ensure that the given indexes exist, and create them if required
let ensureIndexes cfg (indexes : (string * (string * (ReqlExpr -> obj)) list) list) =
indexes
|> List.iter (fun index -> match idx.Contains index with
| true -> ()
| _ -> createIndex cfg table index)
idx
|> List.iter (fun tabl -> let idx = (tbl cfg (fst tabl)).IndexList() |> runListAsync<string> cfg.conn
snd tabl
|> List.iter (fun index -> match idx.Contains (fst index) with
| true -> ()
| _ -> createIndex cfg (fst tabl) index))
let checkCategoryIndexes cfg =
chkIndexes cfg Table.Category [ "webLogId"; "slug" ]
|> ignore
/// Create an index on a single field
let singleField (name : string) : ReqlExpr -> obj = fun row -> upcast row.[name]
let checkCommentIndexes cfg =
chkIndexes cfg Table.Comment [ "postId" ]
|> 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
/// 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])
/// Ensure all the required indexes exist
let checkIndexes cfg =
logStep "|> Checking indexes"
checkCategoryIndexes cfg
checkCommentIndexes cfg
checkPageIndexes cfg
checkPostIndexes cfg
checkUserIndexes cfg
checkWebLogIndexes cfg
[ Table.Category, [ "webLogId", singleField "webLogId"
"slug", webLogField "slug"
]
Table.Comment, [ "postId", singleField "postId"
]
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 =
logStep "Database Start Up Checks Starting"
checkDatabase cfg

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

@ -30,8 +30,7 @@ let cfg = try DataConfig.fromJson (System.IO.File.ReadAllText "data-config.json"
do
startUpCheck cfg
/// Support RESX lookup via the @Translate SSVE alias
type TranslateTokenViewEngineMatcher() =
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
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
member val messages = getMessages () with get, set
/// The currently logged in user

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

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