2016-07-08 03:57:14 +00:00
|
|
|
module myWebLog.Data.SetUp
|
|
|
|
|
|
|
|
open Rethink
|
|
|
|
open RethinkDb.Driver.Ast
|
2016-07-20 03:44:39 +00:00
|
|
|
open System
|
2016-07-08 03:57:14 +00:00
|
|
|
|
2016-07-20 03:44:39 +00:00
|
|
|
let private r = RethinkDb.Driver.RethinkDB.R
|
2016-07-19 04:03:44 +00:00
|
|
|
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.")
|
2016-07-08 03:57:14 +00:00
|
|
|
|
2016-07-19 04:03:44 +00:00
|
|
|
/// Ensure the myWebLog database exists
|
2016-07-08 03:57:14 +00:00
|
|
|
let checkDatabase (cfg : DataConfig) =
|
|
|
|
logStep "|> Checking database"
|
2016-07-20 03:44:39 +00:00
|
|
|
let dbs = r.DbList().RunListAsync<string>(cfg.conn) |> await
|
2016-07-08 03:57:14 +00:00
|
|
|
match dbs.Contains cfg.database with
|
|
|
|
| true -> ()
|
|
|
|
| _ -> logStepStart (sprintf " %s database not found - creating" cfg.database)
|
2016-07-20 03:44:39 +00:00
|
|
|
r.DbCreate(cfg.database).RunResultAsync(cfg.conn) |> await |> ignore
|
2016-07-08 03:57:14 +00:00
|
|
|
logStepDone ()
|
|
|
|
|
2016-07-19 04:03:44 +00:00
|
|
|
/// Ensure all required tables exist
|
2016-07-08 03:57:14 +00:00
|
|
|
let checkTables cfg =
|
|
|
|
logStep "|> Checking tables"
|
2016-07-20 03:44:39 +00:00
|
|
|
let tables = r.Db(cfg.database).TableList().RunListAsync<string>(cfg.conn) |> await
|
2016-07-08 03:57:14 +00:00
|
|
|
[ Table.Category; Table.Comment; Table.Page; Table.Post; Table.User; Table.WebLog ]
|
|
|
|
|> List.map (fun tbl -> match tables.Contains tbl with
|
|
|
|
| true -> None
|
|
|
|
| _ -> Some (tbl, r.TableCreate tbl))
|
|
|
|
|> List.filter (fun create -> create.IsSome)
|
|
|
|
|> List.map (fun create -> create.Value)
|
|
|
|
|> List.iter (fun (tbl, create) -> logStepStart (sprintf " Creating table %s" tbl)
|
2016-07-20 03:44:39 +00:00
|
|
|
create.RunResultAsync(cfg.conn) |> await |> ignore
|
2016-07-08 03:57:14 +00:00
|
|
|
logStepDone ())
|
|
|
|
|
2016-07-19 04:03:44 +00:00
|
|
|
/// Shorthand to get the table
|
2016-07-08 03:57:14 +00:00
|
|
|
let tbl cfg table = r.Db(cfg.database).Table(table)
|
|
|
|
|
2016-07-19 04:03:44 +00:00
|
|
|
/// Create the given index
|
2016-07-20 03:44:39 +00:00
|
|
|
let createIndex cfg table (index : string * obj) =
|
2016-07-19 04:03:44 +00:00
|
|
|
logStepStart (sprintf """ Creating index "%s" on table %s""" (fst index) table)
|
2016-07-20 03:44:39 +00:00
|
|
|
(tbl cfg table).IndexCreate(fst index, snd index).RunResultAsync(cfg.conn) |> await |> ignore
|
|
|
|
(tbl cfg table).IndexWait(fst index).RunAtomAsync(cfg.conn) |> await |> ignore
|
2016-07-08 03:57:14 +00:00
|
|
|
logStepDone ()
|
|
|
|
|
2016-07-19 04:03:44 +00:00
|
|
|
/// Ensure that the given indexes exist, and create them if required
|
2016-07-20 03:44:39 +00:00
|
|
|
let ensureIndexes cfg (indexes : (string * (string * obj) list) list) =
|
2016-07-08 03:57:14 +00:00
|
|
|
indexes
|
2016-07-20 03:44:39 +00:00
|
|
|
|> List.iter (fun tabl -> let idx = (tbl cfg (fst tabl)).IndexList().RunListAsync<string>(cfg.conn) |> await
|
2016-07-19 04:03:44 +00:00
|
|
|
snd tabl
|
|
|
|
|> List.iter (fun index -> match idx.Contains (fst index) with
|
|
|
|
| true -> ()
|
|
|
|
| _ -> createIndex cfg (fst tabl) index))
|
2016-07-08 03:57:14 +00:00
|
|
|
|
2016-07-19 04:03:44 +00:00
|
|
|
/// Create an index on a single field
|
2016-07-20 03:44:39 +00:00
|
|
|
let singleField (name : string) : obj = upcast (fun row -> (row :> ReqlExpr).[name])
|
2016-07-08 03:57:14 +00:00
|
|
|
|
2016-07-19 04:03:44 +00:00
|
|
|
/// Create an index on web log Id and the given field
|
2016-07-20 03:44:39 +00:00
|
|
|
let webLogField (name : string) : obj = upcast (fun row -> r.Array((row :> ReqlExpr).["webLogId"], row.[name]))
|
2016-07-08 03:57:14 +00:00
|
|
|
|
2016-07-19 04:03:44 +00:00
|
|
|
/// Ensure all the required indexes exist
|
2016-07-08 03:57:14 +00:00
|
|
|
let checkIndexes cfg =
|
|
|
|
logStep "|> Checking indexes"
|
2016-07-19 04:03:44 +00:00
|
|
|
[ 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"
|
|
|
|
]
|
2016-07-20 03:44:39 +00:00
|
|
|
Table.User, [ "logOn", upcast (fun row -> r.Array((row :> ReqlExpr).["userName"], row.["passwordHash"]))
|
2016-07-19 04:03:44 +00:00
|
|
|
]
|
|
|
|
Table.WebLog, [ "urlBase", singleField "urlBase"
|
|
|
|
]
|
|
|
|
]
|
|
|
|
|> ensureIndexes cfg
|
|
|
|
|
|
|
|
/// Start up checks to ensure the database, tables, and indexes exist
|
2016-07-08 03:57:14 +00:00
|
|
|
let startUpCheck cfg =
|
|
|
|
logStep "Database Start Up Checks Starting"
|
|
|
|
checkDatabase cfg
|
|
|
|
checkTables cfg
|
|
|
|
checkIndexes cfg
|
|
|
|
logStep "Database Start Up Checks Complete"
|