From f6c3abfcace677776d97677ae2658dea288380d5 Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Mon, 18 Jul 2016 23:03:44 -0500 Subject: [PATCH] Indexes and subtitle Refactored index creation to a much more functional approach; fixed issue where subtitle was displaying Some(subtitle) --- src/myWebLog.Data/SetUp.fs | 155 ++++++------------ src/myWebLog.Web/App.fs | 3 +- src/myWebLog.Web/ViewModels.fs | 2 + src/myWebLog/views/themes/default/layout.html | 2 +- 4 files changed, 51 insertions(+), 111 deletions(-) diff --git a/src/myWebLog.Data/SetUp.fs b/src/myWebLog.Data/SetUp.fs index eb545ae..c029578 100644 --- a/src/myWebLog.Data/SetUp.fs +++ b/src/myWebLog.Data/SetUp.fs @@ -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 cfg.conn + let dbs = r.DbList() |> runListAsync 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 cfg.conn + let tables = r.Db(cfg.database).TableList() |> runListAsync 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 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 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 diff --git a/src/myWebLog.Web/App.fs b/src/myWebLog.Web/App.fs index 24e5175..b021a56 100644 --- a/src/myWebLog.Web/App.fs +++ b/src/myWebLog.Web/App.fs @@ -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\.(?[a-zA-Z0-9-_]+);?", RegexOptions.Compiled) diff --git a/src/myWebLog.Web/ViewModels.fs b/src/myWebLog.Web/ViewModels.fs index 145923a..5c92df6 100644 --- a/src/myWebLog.Web/ViewModels.fs +++ b/src/myWebLog.Web/ViewModels.fs @@ -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 diff --git a/src/myWebLog/views/themes/default/layout.html b/src/myWebLog/views/themes/default/layout.html index 6934790..f670fbe 100644 --- a/src/myWebLog/views/themes/default/layout.html +++ b/src/myWebLog/views/themes/default/layout.html @@ -16,7 +16,7 @@
@Model.webLog.name
-

@Model.webLog.subtitle

+

@Model.webLogSubtitle